fcl-passrc: specialize try-except

git-svn-id: trunk@42680 -

packages/fcl-passrc/src/pasresolver.pp

@@ -15122,7 +15122,10 @@ begin
       or (C=TPasImplTryExceptElse) then
     SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
   else if C=TPasImplExceptOn then
-    SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl))
+    begin
+    AddExceptOn(TPasImplExceptOn(SpecEl));
+    SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl));
+    end
   else if C=TPasImplRaise then
     SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
   // declaration
@@ -15245,6 +15248,8 @@ begin
       or (GenElType.ClassType=TPasGenericTemplateType) then
     begin
     // reference
+    if GenElType.Name='' then
+      RaiseNotYetImplemented(20190813213555,GenEl,GetObjName(GenElType)+' Parent='+GetObjName(GenElType.Parent));
     Ref:=FindElement(GenElType.Name);
     if not (Ref is TPasType) then
       RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref));
@@ -15677,13 +15682,11 @@ procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
 begin
   SpecializeImplBlock(GenEl,SpecEl); // clone elements
   if GenEl.FinallyExcept<>nil then
-    SpecializeElImplAlias(GenEl,SpecEl,GenEl.FinallyExcept,
-      TPasImplElement(SpecEl.FinallyExcept)
-      {$IFDEF CheckPasTreeRefCount},'TPasImplTry.FinallyExcept'{$ENDIF});
+    SpecializeElImplEl(GenEl,SpecEl,GenEl.FinallyExcept,
+      TPasImplElement(SpecEl.FinallyExcept));
   if GenEl.ElseBranch<>nil then
-    SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,
-      TPasImplElement(SpecEl.ElseBranch)
-      {$IFDEF CheckPasTreeRefCount},'TPasImplTry.ElseBranch'{$ENDIF});
+    SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,
+      TPasImplElement(SpecEl.ElseBranch));
 end;
 
 procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
@@ -18271,7 +18274,7 @@ begin
     {AllowWriteln-}
     {$ENDIF}
     if not IsValidIdent(CurName) then
-      RaiseNotYetImplemented(20170328000033,ErrorEl);
+      RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
     if CurScopeEl<>nil then
       begin
       NeedPop:=true;
@@ -20064,7 +20067,7 @@ var
 begin
   s:=sNotYetImplemented+' ['+IntToStr(id)+']';
   if Msg<>'' then
-    s:=s+' '+Msg;
+    s:=s+' "'+Msg+'"';
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
   {$ENDIF}

packages/fcl-passrc/src/pparser.pp

@@ -5735,6 +5735,7 @@ var
   Name: String;
   TypeEl: TPasType;
   ImplRaise: TPasImplRaise;
+  VarEl: TPasVariable;
 
 begin
   NewImplElement:=nil;
@@ -6184,10 +6185,12 @@ begin
                 NextToken;
                 TypeEl:=ParseSimpleType(El,SrcPos,'');
                 TPasImplExceptOn(El).TypeEl:=TypeEl;
-                TPasImplExceptOn(El).VarEl:=TPasVariable(CreateElement(TPasVariable,
-                                      Name,El,SrcPos));
-                TPasImplExceptOn(El).VarEl.VarType:=TypeEl;
+                VarEl:=TPasVariable(CreateElement(TPasVariable,Name,El,SrcPos));
+                TPasImplExceptOn(El).VarEl:=VarEl;
+                VarEl.VarType:=TypeEl;
                 TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
+                if TypeEl.Parent=El then
+                  TypeEl.Parent:=VarEl;
                 end
               else
                 begin

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -83,7 +83,7 @@ type
     procedure TestGen_LocalVar;
     procedure TestGen_Statements;
     // ToDo: for-in
-    // ToDo: try finally/except
+    procedure TestGen_TryExcept;
     // ToDo: call
     // ToDo: dot
     // ToDo: is as
@@ -725,6 +725,49 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_TryExcept;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  '  Exception = class',
+  '  end;',
+  '  generic EMsg<T> = class',
+  '    Msg: T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  'var',
+  '  v1,v2,v3:T;',
+  'begin',
+  '  try',
+  '  finally',
+  '  end;',
+  '  try',
+  '    v1:=v2;',
+  '  finally',
+  '    v2:=v1;',
+  '  end;',
+  '  try',
+  '  except',
+  '    on Exception do ;',
+  '    on E: Exception do ;',
+  '    on E: EMsg<boolean> do E.Msg:=true;',
+  '    on E: EMsg<T> do E.Msg:=1;',
+  '  end;',
+  'end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '  b.Fly(2);',
+  '']);
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);