Conditions in for/while/repeat are now expression elements

git-svn-id: trunk@22028 -

packages/fcl-passrc/src/pastree.pp

@@ -878,12 +878,12 @@ type
     function AddBeginBlock: TPasImplBeginBlock;
     function AddRepeatUntil: TPasImplRepeatUntil;
     function AddIfElse(const ACondition: TPasExpr): TPasImplIfElse;
-    function AddWhileDo(const ACondition: string): TPasImplWhileDo;
+    function AddWhileDo(const ACondition: TPasExpr): TPasImplWhileDo;
     function AddWithDo(const Expression: string): TPasImplWithDo;
     function AddCaseOf(const Expression: string): TPasImplCaseOf;
     function AddForLoop(AVar: TPasVariable;
-      const AStartValue, AEndValue: string): TPasImplForLoop;
-    function AddForLoop(const AVarName, AStartValue, AEndValue: string;
+      const AStartValue, AEndValue: TPasExpr): TPasImplForLoop;
+    function AddForLoop(const AVarName : String; AStartValue, AEndValue: TPasExpr;
       ADownTo: Boolean = false): TPasImplForLoop;
     function AddTry: TPasImplTry;
     function AddExceptOn(const VarName, TypeName: string): TPasImplExceptOn;
@@ -922,7 +922,9 @@ type
 
   TPasImplRepeatUntil = class(TPasImplBlock)
   public
-    Condition: string;
+    ConditionExpr : TPasExpr;
+    destructor Destroy; override;
+    Function Condition: string;
   end;
 
   { TPasImplIfElse }
@@ -946,8 +948,9 @@ type
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
   public
-    Condition: string;
+    ConditionExpr : TPasExpr;
     Body: TPasImplElement;
+    function Condition: string;
   end;
 
   { TPasImplWithDo }
@@ -1005,9 +1008,13 @@ type
     procedure AddElement(Element: TPasImplElement); override;
   public
     Variable: TPasVariable;
-    VariableName, StartValue, EndValue: string;
+    StartExpr : TPasExpr;
+    EndExpr : TPasExpr;
+    VariableName : String;
     Down: boolean; // downto
     Body: TPasImplElement;
+    Function StartValue : String;
+    Function EndValue: string;
   end;
 
   { TPasImplAssign }
@@ -1121,6 +1128,22 @@ implementation
 
 uses SysUtils;
 
+{ TPasImplRepeatUntil }
+
+destructor TPasImplRepeatUntil.Destroy;
+begin
+  FreeAndNil(ConditionExpr);
+  inherited Destroy;
+end;
+
+function TPasImplRepeatUntil.Condition: string;
+begin
+  If Assigned(ConditionExpr) then
+    Result:=ConditionExpr.GetDeclaration(True)
+  else
+    Result:='';
+end;
+
 { TPasImplSimple }
 
 destructor TPasImplSimple.Destroy;
@@ -1851,6 +1874,8 @@ end;
 
 destructor TPasImplForLoop.Destroy;
 begin
+  FreeAndNil(StartExpr);
+  FreeAndNil(EndExpr);
   if Assigned(Variable) then
     Variable.Release;
   if Assigned(Body) then
@@ -1870,6 +1895,22 @@ begin
     raise Exception.Create('TPasImplForLoop.AddElement body already set - please report this bug');
 end;
 
+function TPasImplForLoop.StartValue: String;
+begin
+  If Assigned(StartExpr) then
+    Result:=StartExpr.GetDeclaration(true)
+  else
+    Result:='';
+end;
+
+function TPasImplForLoop.EndValue: string;
+begin
+  If Assigned(EndExpr) then
+    Result:=EndExpr.GetDeclaration(true)
+  else
+    Result:='';
+end;
+
 constructor TPasImplBlock.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -1923,10 +1964,10 @@ begin
   AddElement(Result);
 end;
 
-function TPasImplBlock.AddWhileDo(const ACondition: string): TPasImplWhileDo;
+function TPasImplBlock.AddWhileDo(const ACondition: TPasExpr): TPasImplWhileDo;
 begin
   Result := TPasImplWhileDo.Create('', Self);
-  Result.Condition := ACondition;
+  Result.ConditionExpr := ACondition;
   AddElement(Result);
 end;
 
@@ -1945,22 +1986,22 @@ begin
 end;
 
 function TPasImplBlock.AddForLoop(AVar: TPasVariable; const AStartValue,
-  AEndValue: string): TPasImplForLoop;
+  AEndValue: TPasExpr): TPasImplForLoop;
 begin
   Result := TPasImplForLoop.Create('', Self);
   Result.Variable := AVar;
-  Result.StartValue := AStartValue;
-  Result.EndValue := AEndValue;
+  Result.StartExpr := AStartValue;
+  Result.EndExpr:= AEndValue;
   AddElement(Result);
 end;
 
-function TPasImplBlock.AddForLoop(const AVarName, AStartValue,
-  AEndValue: string; ADownTo: Boolean): TPasImplForLoop;
+function TPasImplBlock.AddForLoop(const AVarName: String; AStartValue,
+  AEndValue: TPasExpr; ADownTo: Boolean): TPasImplForLoop;
 begin
   Result := TPasImplForLoop.Create('', Self);
   Result.VariableName := AVarName;
-  Result.StartValue := AStartValue;
-  Result.EndValue := AEndValue;
+  Result.StartExpr := AStartValue;
+  Result.EndExpr := AEndValue;
   Result.Down := ADownTo;
   AddElement(Result);
 end;
@@ -2689,6 +2730,7 @@ end;
 
 destructor TPasImplWhileDo.Destroy;
 begin
+  FreeAndNil(ConditionExpr);
   if Assigned(Body) then
     Body.Release;
   inherited Destroy;
@@ -2706,6 +2748,12 @@ begin
     raise Exception.Create('TPasImplWhileDo.AddElement body already set - please report this bug');
 end;
 
+function TPasImplWhileDo.Condition: string;
+begin
+  If Assigned(ConditionExpr) then
+    Result:=ConditionExpr.GetDeclaration(True);
+end;
+
 { TPasImplCaseOf }
 
 destructor TPasImplCaseOf.Destroy;

packages/fcl-passrc/src/pparser.pp

@@ -2130,14 +2130,8 @@ begin
       Result.VarType := ParseType(nil)
     else
       UngetToken;
-
     ExpectToken(tkEqual);
-
-    //skipping the expression as a value
-    //Result.Value := ParseExpression;
-
-    // using new expression parser!
-    NextToken; // skip tkEqual
+    NextToken;
     Result.Expr:=DoParseConstValueExpression(Result);
 
     // must unget for the check to be peformed fine!
@@ -3110,10 +3104,12 @@ begin
     tkwhile:
       begin
         // while Condition do
-        Condition:=ParseExpression(Parent);
+        NextToken;
+        left:=DoParseExpression(Parent);
+        ungettoken;
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
         el:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
-        TPasImplWhileDo(el).Condition:=Condition;
+        TPasImplWhileDo(el).ConditionExpr:=left;
         CreateBlock(TPasImplWhileDo(el));
         ExpectToken(tkdo);
       end;
@@ -3129,7 +3125,9 @@ begin
         ExpectIdentifier;
         VarName:=CurTokenString;
         ExpectToken(tkAssign);
-        StartValue:=ParseExpression(Parent);
+        NextToken;
+        Left:=DoParseExpression(Parent);
+        UnGetToken;
         //writeln(i,'FOR Start=',StartValue);
         NextToken;
         if CurToken=tkTo then
@@ -3138,11 +3136,13 @@ begin
           ForDownTo:=true
         else
           ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
-        EndValue:=ParseExpression(Parent);
+        NextToken;
+        Right:=DoParseExpression(Parent);
+        UngetToken;
         el:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
         TPasImplForLoop(el).VariableName:=VarName;
-        TPasImplForLoop(el).StartValue:=StartValue;
-        TPasImplForLoop(el).EndValue:=EndValue;
+        TPasImplForLoop(el).StartExpr:=Left;
+        TPasImplForLoop(el).EndExpr:=Right;
         TPasImplForLoop(el).Down:=forDownto;
         CreateBlock(TPasImplForLoop(el));
         //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
@@ -3338,8 +3338,10 @@ begin
         end;
         if CurBlock is TPasImplRepeatUntil then
         begin
-          Condition:=ParseExpression(Parent);
-          TPasImplRepeatUntil(CurBlock).Condition:=Condition;
+          NextToken;
+          Left:=DoParseExpression(Parent);
+          UngetToken;
+          TPasImplRepeatUntil(CurBlock).ConditionExpr:=Left;
           //WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
           if CloseBlock then break;
         end else