fcl-passrc: fixed mem leak on error parsing generic

git-svn-id: trunk@45588 -

packages/fcl-passrc/src/pasresolver.pp

@@ -16412,10 +16412,7 @@ var
       writeln('InsertBehind Generic=',GetObjName(GenericEl),' Last=',GetObjName(Last));
       //for i:=0 to List.Count-1 do writeln('  ',GetObjName(TObject(List[i])));
       {$ENDIF}
-      if GenericEl is TPasProcedure then
-        i:=List.Count-1
-      else
-        RaiseNotYetImplemented(20190826150507,El);
+      i:=List.Count-1;
       end;
     List.Insert(i+1,NewEl);
   end;

packages/fcl-passrc/src/pparser.pp

@@ -4428,8 +4428,10 @@ var
   ArrEl: TPasArrayType;
   i: Integer;
   AObjKind: TPasObjKind;
+  ok: Boolean;
 begin
   Result:=nil;
+  ok := false;
   TypeName := CurTokenString;
   NamePos := CurSourcePos;
   TypeParams:=TFPList.Create;
@@ -4510,7 +4512,10 @@ begin
     else
       ParseExcTypeParamsNotAllowed;
     end;
+    ok:=true;
   finally
+    if (not ok) and (Result<>nil) and not AddToParent then
+      Result.Release({$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF});
     for i:=0 to TypeParams.Count-1 do
       TPasElement(TypeParams[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
     TypeParams.Free;

packages/fcl-passrc/tests/tcgenerics.pp

@@ -9,7 +9,7 @@ uses
 
 Type
 
-  { TTestGenerics }
+  { TTestGenerics - for resolver see unit tcresolvegenerics }
 
   TTestGenerics = Class(TBaseTestTypeParser)
   Published

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -51,6 +51,7 @@ type
     procedure TestGen_RecordDelphi;
     procedure TestGen_RecordNestedSpecialized;
     procedure TestGen_Record_SpecializeSelfInsideFail;
+    procedure TestGen_Record_ReferGenericSelfFail;
     procedure TestGen_RecordAnoArray;
     // ToDo: unitname.specialize TBird<word>.specialize
     procedure TestGen_RecordNestedSpecialize;
@@ -697,6 +698,21 @@ begin
     nTypeXIsNotYetCompletelyDefined);
 end;
 
+procedure TTestResolveGenerics.TestGen_Record_ReferGenericSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'Type',
+  '  TBird<T> = record',
+  '    b: TBird<T>;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('type "TBird<>" is not yet completely defined',
+    nTypeXIsNotYetCompletelyDefined);
+end;
+
 procedure TTestResolveGenerics.TestGen_RecordAnoArray;
 begin
   StartProgram(false);

packages/pastojs/tests/tcgenerics.pas

@@ -16,8 +16,7 @@ type
   Published
     // generic record
     Procedure TestGen_RecordEmpty;
-    Procedure TestGen_Record_ClassProc_ObjFPC;
-    //Procedure TestGen_Record_ClassProc_Delphi;
+    Procedure TestGen_Record_ClassProc;
     //Procedure TestGen_Record_ReferGenClass_DelphiFail;
 
     // generic class
@@ -29,8 +28,7 @@ type
     Procedure TestGen_Class_TypeInfo;
     Procedure TestGen_Class_TypeOverload; // ToDo TBird, TBird<T>, TBird<S,T>
     Procedure TestGen_Class_ClassProperty;
-    Procedure TestGen_Class_ClassProc_ObjFPC;
-    //Procedure TestGen_Class_ClassProc_Delphi;
+    Procedure TestGen_Class_ClassProc;
     //Procedure TestGen_Class_ReferGenClass_DelphiFail;
     Procedure TestGen_Class_ClassConstructor;
     Procedure TestGen_Class_TypeCastSpecializesWarn;
@@ -105,7 +103,7 @@ begin
     ]));
 end;
 
-procedure TTestGenerics.TestGen_Record_ClassProc_ObjFPC;
+procedure TTestGenerics.TestGen_Record_ClassProc;
 begin
   StartProgram(false);
   Add([
@@ -501,7 +499,7 @@ begin
     '']));
 end;
 
-procedure TTestGenerics.TestGen_Class_ClassProc_ObjFPC;
+procedure TTestGenerics.TestGen_Class_ClassProc;
 begin
   StartProgram(false);
   Add([