fcl-passrc: fixed mem leaks

git-svn-id: trunk@39411 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -3872,7 +3872,7 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
       // switch to unicodestring
       h:=TResEvalString(Result).S;
       Result.Free;
-      Result:=nil;
+      Result:=nil; // in case of exception in GetUnicodeStr
       Result:=TResEvalUTF16.CreateValue(GetUnicodeStr(h,Expr));
       end;
     if Result.Kind=revkString then

packages/fcl-passrc/src/pasresolver.pp

@@ -1098,6 +1098,7 @@ type
     Eval: TOnEvalBIFunction;
     FinishParamsExpression: TOnFinishParamsExpr;
     Flags: TBuiltInProcFlags;
+    destructor Destroy; override;
   end;
 
   { TPRFindData }
@@ -2463,6 +2464,14 @@ begin
   str(a,Result);
 end;
 
+{ TResElDataBuiltInProc }
+
+destructor TResElDataBuiltInProc.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Proc));
+  inherited Destroy;
+end;
+
 { TPasClassIntfMap }
 
 destructor TPasClassIntfMap.Destroy;
@@ -14583,6 +14592,7 @@ begin
   {$ENDIF}
   FreeAndNil(FPendingForwardProcs);
   FreeAndNil(fExprEvaluator);
+  ClearBuiltInIdentifiers;
   inherited Destroy;
   {$IFDEF VerbosePasResolverMem}
   writeln('TPasResolver.Destroy END ',ClassName);
@@ -14605,7 +14615,7 @@ var
 begin
   ClearResolveDataList(lkBuiltIn);
   for bt in TResolverBaseType do
-    FBaseTypes[bt]:=nil;
+    ReleaseAndNil(TPasElement(FBaseTypes[bt]));
   for bp in TResolverBuiltInProc do
     FBuiltInProcs[bp]:=nil;
 end;
@@ -19912,6 +19922,7 @@ begin
         else
           Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
     else
+      ReleaseEvalValue(Range);
       RaiseNotYetImplemented(20170601195240,ErrorEl);
     end;
   revkRangeUInt:
@@ -19920,8 +19931,10 @@ begin
     else
       Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
   else
+    ReleaseEvalValue(Range);
     RaiseNotYetImplemented(20170601195336,ErrorEl);
   end;
+  ReleaseEvalValue(Range);
 end;
 
 function TPasResolver.EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags

packages/fcl-passrc/src/pastree.pp

@@ -1578,6 +1578,10 @@ const
 
 procedure ReleaseAndNil(var El: TPasElement); overload;
 
+{$IFDEF HasPTDumpStack}
+function PTDumpStack: string;
+{$ENDIF}
+
 implementation
 
 uses SysUtils;
@@ -1590,6 +1594,32 @@ begin
   El:=nil;
 end;
 
+{$IFDEF HasPTDumpStack}
+function PTDumpStack: string;
+var
+  bp: Pointer;
+  addr: Pointer;
+  oldbp: Pointer;
+  CurAddress: Shortstring;
+begin
+  Result:='';
+  { retrieve backtrace info }
+  bp:=get_caller_frame(get_frame);
+  while bp<>nil do begin
+    addr:=get_caller_addr(bp);
+    CurAddress:=BackTraceStrFunc(addr);
+    {AllowWriteln}
+    writeln();
+    {AllowWriteln-}
+    Result:=Result+CurAddress+LineEnding;
+    oldbp:=bp;
+    bp:=get_caller_frame(bp);
+    if (bp<=oldbp) or (bp>(StackBottom + StackLength)) then
+      bp:=nil;
+  end;
+end;
+{$ENDIF}
+
 { TPasMethodResolution }
 
 destructor TPasMethodResolution.Destroy;

packages/fcl-passrc/src/pparser.pp

@@ -339,7 +339,7 @@ type
     function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
     function CheckPackMode: TPackMode;
     function AddUseUnit(ASection: TPasSection; const NamePos: TPasSourcePos;
-      AUnitName : string; NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasElement;
+      AUnitName : string; NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasUsesUnit;
     procedure CheckImplicitUsedUnits(ASection: TPasSection);
     procedure FinishedModule; virtual;
     // Overload handling
@@ -433,11 +433,11 @@ type
     property Engine: TPasTreeContainer read FEngine;
     property CurToken: TToken read FCurToken;
     property CurTokenString: String read FCurTokenString;
-    Property Options : TPOptions Read FOptions Write SetOptions;
-    Property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches Write SetCurrentModeSwitches;
-    Property CurModule : TPasModule Read FCurModule;
-    Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
-    Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
+    property Options : TPOptions Read FOptions Write SetOptions;
+    property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches Write SetCurrentModeSwitches;
+    property CurModule : TPasModule Read FCurModule;
+    property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
+    property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
     property ImplicitUses: TStrings read FImplicitUses;
     property LastMsg: string read FLastMsg write FLastMsg;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
@@ -3498,7 +3498,7 @@ end;
 
 function TPasParser.AddUseUnit(ASection: TPasSection;
   const NamePos: TPasSourcePos; AUnitName: string; NameExpr: TPasExpr;
-  InFileExpr: TPrimitiveExpr): TPasElement;
+  InFileExpr: TPrimitiveExpr): TPasUsesUnit;
 
   procedure CheckDuplicateInUsesList(AUnitName : string; UsesClause: TPasUsesClause);
   var
@@ -3558,6 +3558,8 @@ begin
         NameExpr.Release;
       if InFileExpr<>nil then
         InFileExpr.Release;
+      if UnitRef<>nil then
+        UnitRef.Release;
       end;
   end;
 end;

packages/fcl-passrc/src/pscanner.pp

@@ -2404,7 +2404,8 @@ begin
   FreeAndNil(FMacros);
   FreeAndNil(FDefines);
   ClearFiles;
-  FIncludeStack.Free;
+  FreeAndNil(FFiles);
+  FreeAndNil(FIncludeStack);
   inherited Destroy;
 end;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -386,6 +386,7 @@ type
     Procedure TestProcOverloadWithBaseTypes2;
     Procedure TestProcOverloadWithDefaultArgs;
     Procedure TestProcOverloadNearestHigherPrecision;
+    Procedure TestProcOverloadStringArgCount;
     Procedure TestProcCallLowPrecision;
     Procedure TestProcOverloadUntyped;
     Procedure TestProcOverloadMultiLowPrecisionFail;
@@ -5939,6 +5940,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcOverloadStringArgCount;
+begin
+  StartProgram(false);
+  Add([
+  'function {#a}StrToDate(const a: String): double; begin end;',
+  'function {#b}StrToDate(const a: String; const b: string): double; begin end;',
+  'function {#c}StrToDate(const a: String; const b: string; c: char): double; begin end;',
+  'var d: double;',
+  'begin',
+  '  d:={@a}StrToDate('''');',
+  '  d:={@b}StrToDate('''','''');',
+  '  d:={@c}StrToDate('''','''',''x'');',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcCallLowPrecision;
 begin
   StartProgram(false);