fcl-passrc: fixed mem leaks and double releases

git-svn-id: trunk@39456 -

packages/fcl-passrc/src/pasresolver.pp

@@ -4582,7 +4582,11 @@ procedure TPasResolver.FinishTypeSection(El: TPasDeclarations);
       TopScope,@OnFindFirstElement,@Data,Abort);
     if (Data.Found=nil) then
       if MustExist then
-        RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl)
+        begin
+        if DestType is TUnresolvedPendingRef then
+          DestType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+        RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl);
+        end
       else
         exit(false);
     if Data.Found=DestType then exit;
@@ -13718,95 +13722,101 @@ begin
   El:=AClass.Create(AName,AParent);
   {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('CreateElement');{$ENDIF}
   FLastElement:=El;
-  Result:=El;
-  El.Visibility:=AVisibility;
-  El.SourceFilename:=ASrcPos.FileName;
-  El.SourceLinenumber:=SrcY;
-  if FRootElement=nil then
-    begin
-    RootElement:=NoNil(Result) as TPasModule;
-    if FStep=prsInit then
-      FStep:=prsParsing;
-    end
-  else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
-    begin
-    // first element of section
-    SectionScope:=TPasSectionScope(AParent.CustomData);
-    SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
-    SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
-    end;
-
-  if IsElementSkipped(El) then exit;
+  Result:=nil;
+  try
+    El.Visibility:=AVisibility;
+    El.SourceFilename:=ASrcPos.FileName;
+    El.SourceLinenumber:=SrcY;
+    if FRootElement=nil then
+      begin
+      RootElement:=El as TPasModule;
+      if FStep=prsInit then
+        FStep:=prsParsing;
+      end
+    else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
+      begin
+      // first element of section
+      SectionScope:=TPasSectionScope(AParent.CustomData);
+      SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
+      SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
+      end;
 
-  // create scope
-  if (AClass=TPasVariable)
-      or (AClass=TPasConst) then
-    AddVariable(TPasVariable(El))
-  else if AClass=TPasResString then
-    AddResourceString(TPasResString(El))
-  else if (AClass=TPasProperty) then
-    AddProperty(TPasProperty(El))
-  else if AClass=TPasArgument then
-    AddArgument(TPasArgument(El))
-  else if AClass=TPasEnumType then
-    AddEnumType(TPasEnumType(El))
-  else if AClass=TPasEnumValue then
-    AddEnumValue(TPasEnumValue(El))
-  else if (AClass=TUnresolvedPendingRef) then
-  else if (AClass=TPasAliasType)
-      or (AClass=TPasTypeAliasType)
-      or (AClass=TPasClassOfType)
-      or (AClass=TPasPointerType)
-      or (AClass=TPasArrayType)
-      or (AClass=TPasProcedureType)
-      or (AClass=TPasFunctionType)
-      or (AClass=TPasSetType)
-      or (AClass=TPasRangeType) then
-    AddType(TPasType(El))
-  else if AClass=TPasStringType then
-    begin
-    AddType(TPasType(El));
-    if BaseTypes[btShortString]=nil then
-      RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
-    end
-  else if AClass=TPasRecordType then
-    AddRecordType(TPasRecordType(El))
-  else if AClass=TPasClassType then
-    AddClassType(TPasClassType(El))
-  else if AClass=TPasVariant then
-  else if AClass.InheritsFrom(TPasProcedure) then
-    AddProcedure(TPasProcedure(El))
-  else if AClass=TPasResultElement then
-    AddFunctionResult(TPasResultElement(El))
-  else if AClass=TProcedureBody then
-    AddProcedureBody(TProcedureBody(El))
-  else if AClass=TPasMethodResolution then
-  else if AClass=TPasImplExceptOn then
-    AddExceptOn(TPasImplExceptOn(El))
-  else if AClass=TPasImplLabelMark then
-  else if AClass=TPasOverloadedProc then
-  else if (AClass=TInterfaceSection)
-      or (AClass=TImplementationSection)
-      or (AClass=TProgramSection)
-      or (AClass=TLibrarySection) then
-    AddSection(TPasSection(El))
-  else if (AClass=TPasModule)
-      or (AClass=TPasProgram)
-      or (AClass=TPasLibrary) then
-    AddModule(TPasModule(El))
-  else if AClass=TPasUsesUnit then
-  else if AClass.InheritsFrom(TPasExpr) then
-    // resolved when finished
-  else if AClass=TInitializationSection then
-    AddInitialFinalizationSection(TInitializationSection(El))
-  else if AClass=TFinalizationSection then
-    AddInitialFinalizationSection(TFinalizationSection(El))
-  else if AClass.InheritsFrom(TPasImplBlock) then
-    // resolved when finished
-  else if AClass=TPasUnresolvedUnitRef then
-    RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
-  else
-    RaiseNotYetImplemented(20160922163544,El);
+    if IsElementSkipped(El) then exit;
+
+    // create scope
+    if (AClass=TPasVariable)
+        or (AClass=TPasConst) then
+      AddVariable(TPasVariable(El))
+    else if AClass=TPasResString then
+      AddResourceString(TPasResString(El))
+    else if (AClass=TPasProperty) then
+      AddProperty(TPasProperty(El))
+    else if AClass=TPasArgument then
+      AddArgument(TPasArgument(El))
+    else if AClass=TPasEnumType then
+      AddEnumType(TPasEnumType(El))
+    else if AClass=TPasEnumValue then
+      AddEnumValue(TPasEnumValue(El))
+    else if (AClass=TUnresolvedPendingRef) then
+    else if (AClass=TPasAliasType)
+        or (AClass=TPasTypeAliasType)
+        or (AClass=TPasClassOfType)
+        or (AClass=TPasPointerType)
+        or (AClass=TPasArrayType)
+        or (AClass=TPasProcedureType)
+        or (AClass=TPasFunctionType)
+        or (AClass=TPasSetType)
+        or (AClass=TPasRangeType) then
+      AddType(TPasType(El))
+    else if AClass=TPasStringType then
+      begin
+      AddType(TPasType(El));
+      if BaseTypes[btShortString]=nil then
+        RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
+      end
+    else if AClass=TPasRecordType then
+      AddRecordType(TPasRecordType(El))
+    else if AClass=TPasClassType then
+      AddClassType(TPasClassType(El))
+    else if AClass=TPasVariant then
+    else if AClass.InheritsFrom(TPasProcedure) then
+      AddProcedure(TPasProcedure(El))
+    else if AClass=TPasResultElement then
+      AddFunctionResult(TPasResultElement(El))
+    else if AClass=TProcedureBody then
+      AddProcedureBody(TProcedureBody(El))
+    else if AClass=TPasMethodResolution then
+    else if AClass=TPasImplExceptOn then
+      AddExceptOn(TPasImplExceptOn(El))
+    else if AClass=TPasImplLabelMark then
+    else if AClass=TPasOverloadedProc then
+    else if (AClass=TInterfaceSection)
+        or (AClass=TImplementationSection)
+        or (AClass=TProgramSection)
+        or (AClass=TLibrarySection) then
+      AddSection(TPasSection(El))
+    else if (AClass=TPasModule)
+        or (AClass=TPasProgram)
+        or (AClass=TPasLibrary) then
+      AddModule(TPasModule(El))
+    else if AClass=TPasUsesUnit then
+    else if AClass.InheritsFrom(TPasExpr) then
+      // resolved when finished
+    else if AClass=TInitializationSection then
+      AddInitialFinalizationSection(TInitializationSection(El))
+    else if AClass=TFinalizationSection then
+      AddInitialFinalizationSection(TFinalizationSection(El))
+    else if AClass.InheritsFrom(TPasImplBlock) then
+      // resolved when finished
+    else if AClass=TPasUnresolvedUnitRef then
+      RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
+    else
+      RaiseNotYetImplemented(20160922163544,El);
+    Result:=El;
+  finally
+    if Result=nil then
+      El.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+  end;
 end;
 
 function TPasResolver.FindModule(const AName: String; NameExpr,

packages/fcl-passrc/src/pastree.pp

@@ -545,7 +545,7 @@ type
     function GetDeclaration(full: boolean) : string; override;
   end;
 
-  { TPasSpecializeType }
+  { TPasSpecializeType DestType<Params> }
 
   TPasSpecializeType = class(TPasAliasType)
   public
@@ -569,7 +569,7 @@ type
       const Arg: Pointer); override;
     procedure ClearTypeReferences(aType: TPasElement); override;
   public
-    DestType: TPasType;
+    DestType: TPasType; // TPasSpecializeType
   end;
 
   { TInlineSpecializeExpr - A<B,C> }
@@ -1619,7 +1619,8 @@ const
 procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF}); overload;
 
 {$IFDEF HasPTDumpStack}
-function PTDumpStack: string;
+procedure PTDumpStack;
+function GetPTDumpStack: string;
 {$ENDIF}
 
 implementation
@@ -1635,7 +1636,14 @@ begin
 end;
 
 {$IFDEF HasPTDumpStack}
-function PTDumpStack: string;
+procedure PTDumpStack;
+begin
+  {AllowWriteln}
+  writeln(GetPTDumpStack);
+  {AllowWriteln-}
+end;
+
+function GetPTDumpStack: string;
 var
   bp: Pointer;
   addr: Pointer;
@@ -2359,8 +2367,13 @@ begin
   {$IFDEF CheckPasTreeRefCount}
   if SameText(aId,'CreateElement') and (RefIds.IndexOf('CreateElement')>=0) then
     begin
+    {AllowWriteln}
     writeln('TPasElement.AddRef ',Name,':',ClassName,' RefCount=',RefCount,' RefIds={',RefIds.Text,'}');
-    raise Exception.Create('TPasElement.AddRef duplicate CreateElement');
+    {AllowWriteln-}
+    {$IFDEF HasPTDumpStack}
+    PTDumpStack;
+    {$ENDIF}
+    Halt;
     end;
   RefIds.Add(aId);
   {$ENDIF}
@@ -2622,7 +2635,7 @@ end;
 procedure TPasPointerType.SetParent(const AValue: TPasElement);
 begin
   if (AValue=nil) and (Parent<>nil) and (DestType<>nil)
-      and (DestType.Parent=Parent) then
+      and ((DestType.Parent=Parent) or (DestType=Self)) then
     begin
     // DestType in same type section can create a loop
     // -> break loop when type section is closed
@@ -2641,7 +2654,7 @@ end;
 procedure TPasAliasType.SetParent(const AValue: TPasElement);
 begin
   if (AValue=nil) and (Parent<>nil) and (DestType<>nil)
-      and (DestType.Parent=Parent) then
+      and ((DestType.Parent=Parent) or (DestType=Self)) then
     begin
     // DestType in same type section can create a loop
     // -> break loop when type section is closed
@@ -2820,6 +2833,10 @@ begin
     // parent is cleared
     // -> clear all child references to this class (releasing loops)
     ForEachCall(@ClearChildReferences,nil);
+    if AncestorType=Self then
+      ReleaseAndNil(TPasElement(AncestorType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
+    if HelperForType=Self then
+      ReleaseAndNil(TPasElement(HelperForType){$IFDEF CheckPasTreeRefCount},'TPasClassType.HelperForType'{$ENDIF});
     end;
   inherited SetParent(AValue);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -111,7 +111,9 @@ type
 
   TCustomTestResolver = Class(TTestParser)
   Private
+    {$IF defined(VerbosePasResolver) or defined(VerbosePasResolverMem)}
     FStartElementRefCount: int64;
+    {$ENDIF}
     FFirstStatement: TPasImplBlock;
     FModules: TObjectList;// list of TTestEnginePasResolver
     FResolverEngine: TTestEnginePasResolver;
@@ -963,7 +965,8 @@ begin
       El:=El.NextRefEl;
       end;
     {$ENDIF}
-    //Fail('TCustomTestResolver.TearDown Was='+IntToStr(FStartElementRefCount)+' Now='+IntToStr(TPasElement.GlobalRefCount));
+    //Halt;
+    Fail('TCustomTestResolver.TearDown GlobalRefCount Was='+IntToStr(FStartElementRefCount)+' Now='+IntToStr(TPasElement.GlobalRefCount));
     end;
   {$ENDIF}
   {$IFDEF VerbosePasResolverMem}

packages/pastojs/tests/tcmodules.pas

@@ -124,6 +124,9 @@ type
     FSkipTests: boolean;
     FSource: TStringList;
     FFirstPasStatement: TPasImplBlock;
+    {$IFDEF EnablePasTreeGlobalRefCount}
+    FElementRefCountAtSetup: int64;
+    {$ENDIF}
     function GetMsgCount: integer;
     function GetMsgs(Index: integer): TTestHintMessage;
     function GetResolverCount: integer;
@@ -1163,6 +1166,10 @@ begin
   FConverter:=CreateConverter;
 
   FExpectedErrorClass:=nil;
+
+  {$IFDEF EnablePasTreeGlobalRefCount}
+  FElementRefCountAtSetup:=FModule.GlobalRefCount;
+  {$ENDIF}
 end;
 
 function TCustomTestModule.CreateConverter: TPasToJSConverter;
@@ -1214,6 +1221,24 @@ begin
     end;
 
   inherited TearDown;
+  {$IFDEF EnablePasTreeGlobalRefCount}
+  if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
+    begin
+    writeln('TCustomTestModule.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
+    {$IFDEF CheckPasTreeRefCount}
+    El:=TPasElement.FirstRefEl;
+    while El<>nil do
+      begin
+      writeln('  ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
+      for i:=0 to El.RefIds.Count-1 do
+        writeln('    ',El.RefIds[i]);
+      El:=El.NextRefEl;
+      end;
+    {$ENDIF}
+    Fail('TCustomTestModule.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
+    end;
+  {$ENDIF}
+  {$ENDIF}
 end;
 
 procedure TCustomTestModule.Add(Line: string);