* Better Except handling

git-svn-id: trunk@22083 -

packages/fcl-passrc/src/pastree.pp

@@ -626,12 +626,13 @@ type
     function GetDeclaration(full : boolean) : string; override;
   public
     VarType: TPasType;
-    Value: string;
     VarModifiers : TVariableModifiers;
     LibraryName,ExportName : string;
     Modifiers : string;
     AbsoluteLocation : String;
     Expr: TPasExpr;
+    Value : String;
+    // Function Value : String;
   end;
 
   { TPasExportSymbol }
@@ -886,7 +887,7 @@ type
     function AddForLoop(const AVarName : String; AStartValue, AEndValue: TPasExpr;
       ADownTo: Boolean = false): TPasImplForLoop;
     function AddTry: TPasImplTry;
-    function AddExceptOn(const VarName, TypeName: string): TPasImplExceptOn;
+    function AddExceptOn(const VarName, TypeName: TPasExpr): TPasImplExceptOn;
     function AddRaise: TPasImplRaise;
     function AddLabelMark(const Id: string): TPasImplLabelMark;
     function AddAssign(left, right: TPasExpr): TPasImplAssign;
@@ -1077,8 +1078,10 @@ type
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
   public
-    VariableName, TypeName: string;
+    VarExpr,TypeExpr : TPasExpr;
     Body: TPasImplElement;
+    Function VariableName : String;
+    Function TypeName: string;
   end;
 
   { TPasImplRaise }
@@ -1717,6 +1720,7 @@ end;
 
 destructor TPasVariable.Destroy;
 begin
+//  FreeAndNil(Expr);
   { Attention, in derived classes, VarType isn't necessarily set!
     (e.g. in Constants) }
   if Assigned(VarType) then
@@ -2026,12 +2030,12 @@ begin
   AddElement(Result);
 end;
 
-function TPasImplBlock.AddExceptOn(const VarName, TypeName: string
+function TPasImplBlock.AddExceptOn(const VarName, TypeName: TPasExpr
   ): TPasImplExceptOn;
 begin
   Result:=TPasImplExceptOn.Create('',Self);
-  Result.VariableName:=VarName;
-  Result.TypeName:=TypeName;
+  Result.VarExpr:=VarName;
+  Result.TypeExpr:=TypeName;
   AddElement(Result);
 end;
 
@@ -2416,9 +2420,8 @@ Const
 Var
   H : TPasMemberHint;
   B : Boolean;
+
 begin
-  if (Value = '') and Assigned(Expr) then
-    Value := Expr.GetDeclaration(full);
   If Assigned(VarType) then
     begin
     If VarType.Name='' then
@@ -2438,6 +2441,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
@@ -2452,8 +2462,8 @@ begin
     else
       Result:=VarType.Name;
     end
-  else
-    Result:=Value;
+  else if Assigned(Expr) then
+    Result:=Expr.GetDeclaration(True);
   S:='';
   If Assigned(Args) and (Args.Count>0) then
     begin
@@ -2905,6 +2915,8 @@ end;
 
 destructor TPasImplExceptOn.Destroy;
 begin
+  FreeAndNil(VarExpr);
+  FreeAndNil(TypeExpr);
   if Assigned(Body) then
     Body.Release;
   inherited Destroy;
@@ -2920,6 +2932,22 @@ begin
     end;
 end;
 
+function TPasImplExceptOn.VariableName: String;
+begin
+  If assigned(VarExpr) then
+    Result:=VarExpr.GetDeclaration(True)
+  else
+    Result:='';
+end;
+
+function TPasImplExceptOn.TypeName: string;
+begin
+  If assigned(TypeExpr) then
+    Result:=TypeExpr.GetDeclaration(True)
+  else
+    Result:='';
+end;
+
 { TPasImplStatement }
 
 function TPasImplStatement.CloseOnSemicolon: boolean;

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, Location: String): Boolean;
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
   protected
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
@@ -2273,7 +2273,7 @@ begin
   Result:=ParseType(Parent,TypeName,True);
 end;
 
-Function TPasParser.GetVariableValueAndLocation(Parent : TPasElement; out Value,Location : String) : Boolean;
+Function TPasParser.GetVariableValueAndLocation(Parent : TPasElement; out Value, Location : String) : Boolean;
 
 begin
   NextToken;
@@ -2366,11 +2366,12 @@ procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibi
 var
   VarNames: TStringList;
   i: Integer;
+//  Value : TPasExpr;
   VarType: TPasType;
   VarEl: TPasVariable;
   H : TPasMemberHints;
   varmods: TVariableModifiers;
-  Mods,Value,Loc,alibname,aexpname : string;
+  Mods,Loc,Value,alibname,aexpname : string;
 
 begin
   VarNames := TStringList.Create;
@@ -2406,6 +2407,10 @@ begin
       Varel.Modifiers:=Mods;
       Varel.VarModifiers:=VarMods;
       VarEl.Value:=Value;
+//      if (i>0) then
+//        Value.AddRef;
+
+      // Value:=//Nil;
       VarEl.AbsoluteLocation:=Loc;
       VarEl.LibraryName:=alibName;
       VarEl.ExportName:=aexpname;
@@ -3277,20 +3282,23 @@ begin
         // on Exception do
         if CurBlock is TPasImplTryExcept then
         begin
-          VarName:='';
-          TypeName:=ParseExpression(Parent);
-          //writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
           NextToken;
+          Left:=Nil;
+          Right:=DoParseExpression(Parent);
+          //writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
+  //        NextToken;
           if CurToken=tkColon then
-          begin
-            VarName:=TypeName;
-            TypeName:=ParseExpression(Parent);
+            begin
+            NextToken;
+            Left:=Right;
+            Right:=DoParseExpression(Parent);
             //writeln(i,'ON v=',VarName,' t=',TypeName,' Token=',CurTokenText);
-          end else
-            UngetToken;
+            end;
+//          else
+          UngetToken;
           el:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
-          TPasImplExceptOn(el).VariableName:=VarName;
-          TPasImplExceptOn(el).TypeName:=TypeName;
+          TPasImplExceptOn(el).VarExpr:=Left;
+          TPasImplExceptOn(el).TypeExpr:=Right;
           CurBlock.AddElement(el);
           CurBlock:=TPasImplExceptOn(el);
           ExpectToken(tkDo);