* Use expression objects in case and constants

git-svn-id: trunk@22084 -

packages/fcl-passrc/src/pastree.pp

@@ -437,9 +437,9 @@ type
   public
     function ElementTypeName: string; override;
   public
-//    IsValueUsed: Boolean;
-//    Value: Integer;
-    AssignedValue : string;
+    Value: TPasExpr;
+    Destructor Destroy; override;
+    Function AssignedValue : string;
   end;
 
   { TPasEnumType }
@@ -475,7 +475,7 @@ type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
   public
-    Values: TStringList;
+    Values: TFPList;
     Members: TPasRecordType;
   end;
 
@@ -631,8 +631,7 @@ type
     Modifiers : string;
     AbsoluteLocation : String;
     Expr: TPasExpr;
-    Value : String;
-    // Function Value : String;
+    Function Value : String;
   end;
 
   { TPasExportSymbol }
@@ -881,7 +880,7 @@ type
     function AddIfElse(const ACondition: TPasExpr): TPasImplIfElse;
     function AddWhileDo(const ACondition: TPasExpr): TPasImplWhileDo;
     function AddWithDo(const Expression: TPasExpr): TPasImplWithDo;
-    function AddCaseOf(const Expression: string): TPasImplCaseOf;
+    function AddCaseOf(const Expression: TPasExpr): TPasImplCaseOf;
     function AddForLoop(AVar: TPasVariable;
       const AStartValue, AEndValue: TPasExpr): TPasImplForLoop;
     function AddForLoop(const AVarName : String; AStartValue, AEndValue: TPasExpr;
@@ -979,8 +978,9 @@ type
     function AddCase(const Expression: TPasExpr): TPasImplCaseStatement;
     function AddElse: TPasImplCaseElse;
   public
-    Expression: string;
+    CaseExpr : TPasExpr;
     ElseBranch: TPasImplCaseElse;
+    function Expression: string;
   end;
 
   { TPasImplCaseStatement }
@@ -1283,6 +1283,21 @@ function TPasRangeType.ElementTypeName: string; begin Result := SPasTreeRangeTyp
 function TPasArrayType.ElementTypeName: string; begin Result := SPasTreeArrayType end;
 function TPasFileType.ElementTypeName: string; begin Result := SPasTreeFileType end;
 function TPasEnumValue.ElementTypeName: string; begin Result := SPasTreeEnumValue end;
+
+destructor TPasEnumValue.Destroy;
+begin
+  FreeAndNil(Value);
+  inherited Destroy;
+end;
+
+function TPasEnumValue.AssignedValue: string;
+begin
+  If Assigned(Value) then
+    Result:=Value.GetDeclaration(True)
+  else
+    Result:='';
+end;
+
 function TPasEnumType.ElementTypeName: string; begin Result := SPasTreeEnumType end;
 function TPasSetType.ElementTypeName: string; begin Result := SPasTreeSetType end;
 function TPasRecordType.ElementTypeName: string; begin Result := SPasTreeRecordType end;
@@ -1579,11 +1594,17 @@ end;
 constructor TPasVariant.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
-  Values := TStringList.Create;
+  Values := TFPList.Create;
 end;
 
 destructor TPasVariant.Destroy;
+
+Var
+  I : Integer;
+
 begin
+  For I:=0 to Values.Count-1 do
+    TObject(Values[i]).Free;
   Values.Free;
   if Assigned(Members) then
     Members.Release;
@@ -1996,10 +2017,10 @@ begin
   AddElement(Result);
 end;
 
-function TPasImplBlock.AddCaseOf(const Expression: string): TPasImplCaseOf;
+function TPasImplBlock.AddCaseOf(const Expression: TPasExpr): TPasImplCaseOf;
 begin
   Result := TPasImplCaseOf.Create('', Self);
-  Result.Expression := Expression;
+  Result.CaseExpr:= Expression;
   AddElement(Result);
 end;
 
@@ -2441,13 +2462,13 @@ begin
     end;
 end;
 
-{
+
 function TPasVariable.Value: String;
 begin
   If Assigned(Expr) then
     Result:=Expr.GetDeclaration(True)
 end;
-}
+
 function TPasProperty.GetDeclaration (full : boolean) : string;
 
 Var
@@ -2782,6 +2803,7 @@ end;
 
 destructor TPasImplCaseOf.Destroy;
 begin
+  FreeAndNil(CaseExpr);
   if Assigned(ElseBranch) then
     ElseBranch.Release;
   inherited Destroy;
@@ -2809,6 +2831,14 @@ begin
   AddElement(Result);
 end;
 
+function TPasImplCaseOf.Expression: string;
+begin
+  if Assigned(CaseExpr) then
+    Result:=CaseExpr.GetDeclaration(True)
+  else
+    Result:='';
+end;
+
 { TPasImplCaseStatement }
 
 constructor TPasImplCaseStatement.Create(const AName: string;

packages/fcl-passrc/src/pparser.pp

@@ -133,7 +133,7 @@ type
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
     procedure DumpCurToken(Const Msg : String);
     function GetVariableModifiers(Parent: TPasElement; Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
-    function GetVariableValueAndLocation(Parent : TPasElement; Out Value, Location: String): Boolean;
+    function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
   protected
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
@@ -866,8 +866,9 @@ begin
         break
       else if CurToken in [tkEqual,tkAssign] then
         begin
-        EnumValue.AssignedValue:=ParseExpression(Result);
         NextToken;
+        EnumValue.Value:=DoParseExpression(Result);
+       // UngetToken;
         if CurToken = tkBraceClose then
           Break
         else if not (CurToken=tkComma) then
@@ -2134,10 +2135,7 @@ begin
     ExpectToken(tkEqual);
     NextToken;
     Result.Expr:=DoParseConstValueExpression(Result);
-
-    // must unget for the check to be peformed fine!
     UngetToken;
-
     CheckHint(Result,True);
   except
     Result.Free;
@@ -2273,15 +2271,17 @@ begin
   Result:=ParseType(Parent,TypeName,True);
 end;
 
-Function TPasParser.GetVariableValueAndLocation(Parent : TPasElement; out Value, Location : String) : Boolean;
+Function TPasParser.GetVariableValueAndLocation(Parent : TPasElement; out Value : TPasExpr; Out Location : String) : Boolean;
 
 begin
+  Value:=Nil;
   NextToken;
   Result:=CurToken=tkEqual;
   if Result then
     begin
-    Value := ParseExpression(Parent);
     NextToken;
+    Value := DoParseExpression(Parent);
+//    NextToken;
     end;
   if (CurToken=tkAbsolute) then
     begin
@@ -2366,12 +2366,12 @@ procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibi
 var
   VarNames: TStringList;
   i: Integer;
-//  Value : TPasExpr;
+  Value : TPasExpr;
   VarType: TPasType;
   VarEl: TPasVariable;
   H : TPasMemberHints;
   varmods: TVariableModifiers;
-  Mods,Loc,Value,alibname,aexpname : string;
+  Mods,Loc,alibname,aexpname : string;
 
 begin
   VarNames := TStringList.Create;
@@ -2388,6 +2388,7 @@ begin
       VarType := ParseComplexType(Nil)
     else
       VarType := ParseComplexType(Parent);
+    Value:=Nil;
     If Full then
       GetVariableValueAndLocation(Parent,Value,Loc);
     H:=CheckHint(Nil,Full);
@@ -2406,11 +2407,8 @@ begin
         VarEl.Hints:=H;
       Varel.Modifiers:=Mods;
       Varel.VarModifiers:=VarMods;
-      VarEl.Value:=Value;
-//      if (i>0) then
-//        Value.AddRef;
-
-      // Value:=//Nil;
+      if (i=0) then
+        VarEl.Expr:=Value;
       VarEl.AbsoluteLocation:=Loc;
       VarEl.LibraryName:=alibName;
       VarEl.ExportName:=aexpname;
@@ -3176,11 +3174,13 @@ begin
       end;
     tkcase:
       begin
-        Expr:=ParseExpression(Parent);
+        NextToken;
+        Left:=DoParseExpression(Parent);
+        UngetToken;
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         ExpectToken(tkof);
         el:=TPasImplCaseOf(CreateElement(TPasImplCaseOf,'',CurBlock));
-        TPasImplCaseOf(el).Expression:=Expr;
+        TPasImplCaseOf(el).CaseExpr:=Left;
         CreateBlock(TPasImplCaseOf(el));
         repeat
           NextToken;
@@ -3491,8 +3491,8 @@ begin
     V:=TPasVariant(CreateElement(TPasVariant, '', ARec));
     ARec.Variants.Add(V);
     Repeat
-      V.Values.Add(ParseExpression(ARec));
       NextToken;
+      V.Values.Add(DoParseExpression(ARec));
       if Not (CurToken in [tkComma,tkColon]) then
         ParseExc(SParserExpectedCommaColon);
     Until (curToken=tkColon);