Being able to do calculations and output things is essential to any scripting language, but very few scripts are useful unless they can also use conditional logic. In this article we'll look at the IF statement, and associated commands, in UCL. Here is the user documentation:

IF tests the value of an expression and, depending upon the form uses, executes one of the following:

Processing the second form of the IF command requires that we keep track of additional context so we can properly handle nested IFs. It also requires a state machine approach to determine where we are in the IF...THEN...ELSE...ENDIF structure. For example, before we hit an IF, we are in the "normal" state. When we find an IF without a THEN on the same line, we enter the waiting-for-then state if the condition is true, or the waiting-for-else state otherwise. If we are waiting for THEN, the next command must be one. Otherwise, we skip commands until we come to the ELSE or ENDIF. If we hit ELSE while waiting for it, we enter the "normal" state again and start executing commands. But if we were processing the THEN, we move to the waiting-for-endif state. ENDIF ends either the waiting-for-else or the waiting-for-endif states. But we also have to handle nested IFs. It wouldn't do to end the outer THEN because we hit an inner ENDIF. This is where the nesting comes in. Each IF (without a THEN on the same line) puts us into a new nesting level with it's own state (starting in the "normal" state). IFs can be nested indefinitely this way.

                            Nesting : TList ;

                        public // Constructor and destructor...
                            constructor Create ;
                            destructor Destroy ; override ;

                        public // API...
                            procedure Nest ;
                            procedure Unnest ;
                            function Get_Awaiting_Then : boolean ;
                            procedure Set_Awaiting_Then( Value : boolean ) ;
                            function Get_Awaiting_Else : boolean ;
                            procedure Set_Awaiting_Else( Value : boolean ) ;
                            function Get_Awaiting_Endif : boolean ;
                            procedure Set_Awaiting_Endif( Value : boolean ) ;

                        public // Properties...
                            property Awaiting_Then : boolean
                                read Get_Awaiting_Then
                                write Set_Awaiting_Then ;
                            property Awaiting_Else : boolean
                                read Get_Awaiting_Else
                                write Set_Awaiting_Else ;
                            property Awaiting_Endif : boolean
                                read Get_Awaiting_Endif
                                write Set_Awaiting_Endif ;

// Constructor and destructor...

constructor TUCL_Context.Create ;

begin
    inherited Create ;

    Nesting := TList.Create ;
end ;


destructor TUCL_Context.Destroy ;

var I : integer ;

begin
    for I := 0 to Nesting.Count - 1 do
    begin
        TUCL_Nest_Context( Nesting[ I ] ).Free ;
        Nesting[ I ] := nil ;
    end ;
    Nesting.Free ;
    Nesting := nil ;
    inherited Destroy ;
end ;


// API...

procedure TUCL_Context.Nest ;

begin
    Nesting.Add( TUCL_Nest_Context.Create ) ;
end ;


procedure TUCL_Context.Unnest ;

begin
    if( Nesting.Count > 0 ) then
    begin
        TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Free ;
        Nesting.Count := Nesting.Count - 1 ;
    end ;
end ;


function TUCL_Context.Get_Awaiting_Then : boolean ;

begin
    if( Nesting.Count = 0 ) then
    begin
        Result := False ;
        exit ;
    end ;
    Result := TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Awaiting_Then ;
end ;


procedure TUCL_Context.Set_Awaiting_Then( Value : boolean ) ;

begin
    if( Nesting.Count > 0 ) then
    begin
        TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Awaiting_Then := Value ;
    end ;
end ;


function TUCL_Context.Get_Awaiting_Else : boolean ;

begin
    if( Nesting.Count = 0 ) then
    begin
        Result := False ;
        exit ;
    end ;
    Result := TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Awaiting_Else ;
end ;


procedure TUCL_Context.Set_Awaiting_Else( Value : boolean ) ;

begin
    if( Nesting.Count > 0 ) then
    begin
        TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Awaiting_Else := Value ;
    end ;
end ;


function TUCL_Context.Get_Awaiting_Endif : boolean ;

begin
    if( Nesting.Count = 0 ) then
    begin
        Result := False ;
        exit ;
    end ;
    Result := TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Awaiting_Endif ;
end ;


procedure TUCL_Context.Set_Awaiting_Endif( Value : boolean ) ;

begin
    if( Nesting.Count > 0 ) then
    begin
        TUCL_Nest_Context( Nesting[ Nesting.Count - 1 ] ).Awaiting_Endif := Value ;
    end ;
end ;

type TUCL_Nest_Context = class Awaiting_Then : boolean ; Awaiting_Else : boolean ; Awaiting_Endif : boolean ; end ;

            if( This_UCL_Context.Awaiting_Then ) then
            begin
                This_UCL_Context.Awaiting_Then := False ;
                if( Sym <> 'then' ) then // Expecting THEN, but found something else
                begin
                    Exception( UCL_INVIFNEST, '' ) ;
                    exit ;
                end ;
                Sym := Edit( Get_Token, 512, 0 ) ; // Get first command following THEN
                if( Sym = '' ) then // All done with this command
                begin
                    exit ;
                end ;
            end ;
            if( This_UCL_Context.Awaiting_Else ) then
            begin
                if( Sym = 'if' ) then
                begin
                    Skip_If_Block ;
                end ;
                if( ( Sym <> 'else' ) and ( Sym <> 'endif' ) ) then
                begin
                    exit ;
                end ;
                This_UCL_Context.Awaiting_Else := False ;
                continue ;
            end ;

If we are in the waiting-for-else states, we check for a nested IF. If found, we call Skip_If_Block (described below) to skip to the end of that IF structure. If the next symbol isn't ELSE, we exit and wait for the next command to come along. Otherwise, we clear the waiting-for-else state, returning us to "normal" state and then continue to process the next command.

          if( Sym = 'if' ) then
          begin
              Process_If ;
          end else
          if( Sym = 'else' ) then // We've processed the THEN block and need to skip the ELSE block
          begin
              if( This_UCL_Context.Nesting.Count = 0 ) then // Not nested
              begin
                  Exception( UCL_INVIFNEST, '' ) ;
                  exit ;
              end ;
              Skip_If_Block ; // Skips to the endif (inclusive)
              exit ;
          end else
          if( Sym = 'endif' ) then
          begin
              if( This_UCL_Context.Nesting.Count = 0 ) then // Not nested
              begin
                  Exception( UCL_INVIFNEST, '' ) ;
                  exit ;
              end ;
              This_UCL_Context.Unnest ;
              exit ;
          end else
          if( Sym = 'then' ) then // Encountered by itself
          begin
              Exception( UCL_INVIFNEST, '' ) ;
              exit ;
          end else

function Skip_If_Block : boolean ;

var Found : boolean ;
    Nest_Level : integer ;
    S : string ;

begin
    Result := False ;
    Nest_Level := 0 ;
    S := Get_Token ;
    while( S <> '' ) do
    begin
        if( lowercase( S ) = 'then' ) then // Single line if-then
        begin
            exit ;
        end ;
        S := Get_Token ;
    end ;
    while( true ) do
    begin
        S := Edit( Get_Command, 8 or 16 or 128 or 256 or 512 ) ;
        if( copy( S, 1, 3 ) = 'if ' ) then
        begin
            Found := False ;
            while( S <> '' ) do
            begin
                if( Parse_Parameter( ' ', S ) = 'then' ) then
                begin
                    Found := True ; // single-line IF
                    break ;
                end ;
            end ; // while( S <> '' )
            if( not Found ) then
            begin
                inc( Nest_Level ) ; // In a new IF block
            end ;
            continue ;
        end ;
        if( copy( S, 1, 5 ) = 'else ' ) then
        begin
            if( Nest_Level <= 0 ) then
            begin
                exit ;
            end ;
        end ;
        if( ( S = 'endif' ) or ( copy( S, 1, 6 ) = 'endif ' ) ) then
        begin
            dec( Nest_Level ) ;
            if( Nest_Level < 0 ) then
            begin
                exit ;
            end ;
            continue ;
        end ;
    end ;
end ; // Skip_If_Block

procedure Process_If ;

var Condition, Err : integer ;
    Context, S, S1 : string ;

begin
    S := Get_Expression( Err, Context ) ; // Get conditional expression
    if(
        ( Err = UCL_EXPSYN )
        and
        ( ( lowercase( Parser.Peek ) = 'then' ) or ( Parser.Peek = '' ) )
      ) then
    begin
        Err := 0 ;
    end ;
    if( ( Err <> 0 ) or ( S = '' ) ) then // Error
    begin
        Exception( UCL_EXPSYN, Context ) ;
        exit ;
    end ;
    Condition := strtoint( UCL_Strtoint( S ) ) and 1 ; // Get integer version of conditional (low bit only)

    S1 := lowercase( Get_Token ) ;
    if( S1 = '' ) then // End of line before THEN
    begin
        if( Interactive ) then
        begin
            Exception( UCL_INVIFNEST, '' ) ;
            exit ;
        end ;
        This_UCL_Context.Nest ;
        if( Condition = 0 ) then
        begin
            This_UCL_Context.Awaiting_Else := True ;
        end else
        begin
            This_UCL_Context.Awaiting_Then := True ;
        end ;
        exit ;
    end ;

    if( S1 <> 'then' ) then
    begin
        Exception( UCL_INVIFNEST, '' ) ;
        exit ;
    end ; // if( S1 <> 'then' )
    if( Parser.Peek = '$' ) then
    begin
        Get_Token ; // Swallow "$"
    end ;

    // Then portion of command
    if( Condition = 0 ) then
    begin
        S := Parser.Grab_Line ; // Eat rest of line
    end ;

Now that we have IF commands working, we can create a regression test file. Regression tests are simply tests that make sure that things that used to work still work. So, we now have a RTest.com file which checks the operation of all the UCL features we've covered so far. As we continue, we will add new things to test. I won't include the entire file here (the current file can be viewed here), but the following is a sample of the file contents:

$ if f$match_wild("ABCDE","*BC*").nes."TRUE" then write sys$output "f$match_wild('ABCDE','*BC*') failed"
$ if f$match_wild("ABCDE","*").nes."TRUE" then write sys$output "f$match_wild('ABCDE','*') failed"
$ if f$match_wild("ABCDE","F").nes."FALSE" then write sys$output "f$match_wild('ABCDE','F') failed"
$ if f$locate("2","12345").nes."1" then write sys$output "f$locate('2','12345') failed"
$ if f$locate("1","12345").nes."0" then write sys$output "f$locate('1','12345') failed"
$ if f$locate("A","12345").nes."5" then write sys$output "f$locate('A','12345') failed"
$ if f$locate("5","12345").nes."4" then write sys$output "f$locate('5','12345') failed"
$ if f$locate("1","").nes."0" then write sys$output "f$locate('1','') failed"

Note that I don't usually include corrected code in articles after the fact, unless there is something to be learned from it. So, there may be slight issues with code covered in some of these articles, but it still serves its instructive purpose. With each binary release, you can get the latest code.