Browse Source

* Properly release procdefs. Patch by Evgenij Savin, fixes issue #40844

Michaël Van Canneyt 1 year ago
parent
commit
adc66b233d
5 changed files with 252 additions and 3 deletions
  1. 29 3
      compiler/pmodules.pas
  2. 12 0
      tests/webtbs/tw40844.pp
  3. 19 0
      tests/webtbs/uw40844a.pp
  4. 120 0
      tests/webtbs/uw40844b.pp
  5. 72 0
      tests/webtbs/uw40844c.pp

+ 29 - 3
compiler/pmodules.pas

@@ -840,6 +840,34 @@ implementation
 
 
     procedure free_unregistered_localsymtable_elements(curr : tmodule);
+      procedure remove_from_procdeflist(adef: tdef);
+        var
+          i: Integer;
+          childdef: tdef;
+        begin
+          if adef=nil then exit;
+          if (adef.typ in [objectdef, recorddef]) and (adef is tabstractrecorddef) then
+            begin
+              if tabstractrecorddef(adef).symtable<>nil then
+                for i:=0 to tabstractrecorddef(adef).symtable.DefList.Count-1 do
+                  begin
+                    childdef:=tdef(tabstractrecorddef(adef).symtable.DefList[i]);
+                    remove_from_procdeflist(childdef);
+                  end;
+            end
+          else
+            if adef.typ=procdef then
+              begin
+                tprocsym(tprocdef(adef).procsym).ProcdefList.Remove(adef);
+                if tprocdef(adef).localst<>nil then
+                  for i:=0 to tprocdef(adef).localst.DefList.Count-1 do
+                    begin
+                      childdef:=tdef(tprocdef(adef).localst.DefList[i]);
+                      remove_from_procdeflist(childdef);
+                    end;
+              end;
+        end;
+
       var
         i: longint;
         def: tdef;
@@ -859,9 +887,7 @@ implementation
                   unless that sym hasn't been registered either (it's possible
                   to have one overload in the interface and another in the
                   implementation) }
-                if (def.typ=procdef) and
-                   tprocdef(def).procsym.is_registered then
-                 tprocsym(tprocdef(def).procsym).ProcdefList.Remove(def);
+                remove_from_procdeflist(def);
                 curr.localsymtable.deletedef(def);
               end;
           end;

+ 12 - 0
tests/webtbs/tw40844.pp

@@ -0,0 +1,12 @@
+program tw40844;
+
+{$ifdef FPC}{$mode DELPHI}{$endif}
+
+uses
+  uw40844a
+  ;
+
+begin
+
+end.
+

+ 19 - 0
tests/webtbs/uw40844a.pp

@@ -0,0 +1,19 @@
+unit uw40844a;
+
+{$ifdef FPC}{$mode DELPHI}{$endif}
+
+interface
+
+uses
+  uw40844b
+  ;
+
+type
+  TSimpleTestSuite = class(TObject)
+  strict private
+    FTests: TFastList<Integer>;
+  end;
+
+implementation
+
+end.

+ 120 - 0
tests/webtbs/uw40844b.pp

@@ -0,0 +1,120 @@
+unit uw40844b;
+
+{$ifdef FPC}{$mode DELPHI}{$endif}
+
+interface
+
+type
+  IComparer<T> = interface
+    function Compare(const Left, Right: T): Integer; overload;
+  end;
+
+  IEnumerable<T> = interface
+    function GetEnumerator: IEnumerable<T>;
+  end;
+
+
+type
+  Enumerable<T> = record
+  public
+    class function Create(const AItems: TArray<T>): Enumerable<T>; overload; static;
+    class operator Implicit(const AItems: IEnumerable<T>): Enumerable<T>;
+    class function Empty: Enumerable<T>; static;
+    function OrderBy(const AComparer: IComparer<T>): Enumerable<T>; overload;
+  end;
+
+  TFastListRec<T> = record
+  public
+    procedure Sort; overload; inline;
+    procedure Sort(const AComparer: IComparer<T>); overload; inline;
+  end;
+
+  { TFastList }
+
+  TFastList<T> = class(TObject)
+  strict private
+    FList: TFastListRec<T>;
+  public
+    function AsEnumerable: Enumerable<T>;
+  end;
+
+  TFastArray = record
+  strict private
+    class procedure SortImpl<T>(L, R: Pointer; const AComparer: IComparer<T>); overload; static;
+    class procedure SortImpl<T>(L, R: Pointer); overload; static;
+  public
+
+    class procedure Sort<T>(AValues: Pointer; ACount: Integer); overload; static; inline;
+    class procedure Sort<T>(AValues: Pointer; ACount: Integer; const AComparer: IComparer<T>); overload; static; inline;
+  end;
+
+implementation
+
+uses
+  uw40844c;
+
+{ TFastArray }
+
+class procedure TFastArray.SortImpl<T>(L, R: Pointer);
+begin
+
+end;
+
+class procedure TFastArray.Sort<T>(AValues: Pointer; ACount: Integer);
+begin
+  SortImpl<T>(AValues, nil);
+end;
+
+class procedure TFastArray.Sort<T>(AValues: Pointer; ACount: Integer; const AComparer: IComparer<T>);
+begin
+  SortImpl<TObject> (AValues, nil, nil);
+  SortImpl<T>(AValues, nil, nil);
+end;
+
+class procedure TFastArray.SortImpl<T>(L, R: Pointer; const AComparer: IComparer<T>);
+begin
+
+end;
+
+{ Enumerable<T> }
+
+class function Enumerable<T>.Create(const AItems: TArray<T>): Enumerable<T>;
+begin
+  TArrayEnumerable<T>.Create(AItems);
+end;
+
+class operator Enumerable<T>.Implicit(const AItems: IEnumerable<T>): Enumerable<T>;
+begin
+
+end;
+
+function Enumerable<T>.OrderBy(const AComparer: IComparer<T>): Enumerable<T>;
+begin
+  Result := TStableOrderByEnumerable.Create<T>(nil, AComparer);
+end;
+
+class function Enumerable<T>.Empty: Enumerable<T>;
+begin
+  Result := TEmptyEnumerable<T>.Create;
+end;
+
+{ TFastListRec<T> }
+
+procedure TFastListRec<T>.Sort(const AComparer: IComparer<T>);
+begin
+  TFastArray.Sort<T>(nil, 0, AComparer);
+end;
+
+procedure TFastListRec<T>.Sort;
+begin
+  TFastArray.Sort<T>(nil, 0);
+end;
+
+{ TFastList<T> }
+
+function TFastList<T>.AsEnumerable: Enumerable<T>;
+begin
+
+end;
+
+end.

+ 72 - 0
tests/webtbs/uw40844c.pp

@@ -0,0 +1,72 @@
+unit uw40844c;
+
+{$ifdef FPC}{$mode DELPHI}{$endif}
+
+interface
+
+uses
+  uw40844b
+  ;
+
+type
+  TArrayEnumerable<T> = class(TInterfacedObject, IEnumerable<T>)
+  private
+    function GetEnumerator: IEnumerable<T>;
+  public
+    constructor Create(const Arr: TArray<T>);
+  end;
+
+
+  TStableOrderByEnumerable = record
+  strict private type
+    TImpl<T> = class(TInterfacedObject, IEnumerable<T>)
+    public
+      function GetEnumerator: IEnumerable<T>;
+    end;
+  public
+    class function Create<T>(const AItems: IEnumerable<T>; const AComparer: IComparer<T>): IEnumerable<T>; overload; static;
+  end;
+
+  TEmptyEnumerable<T> = class(TInterfacedObject, IEnumerable<T>)
+  strict private
+    class var FInstance: IEnumerable<T>;
+    function GetEnumerator: IEnumerable<T>;
+  end;
+
+implementation
+
+{ TArrayEnumerable<T> }
+
+constructor TArrayEnumerable<T>.Create(const Arr: TArray<T>);
+var IntfEnum: IEnumerable<IUnknown>;
+begin
+
+end;
+
+function TArrayEnumerable<T>.GetEnumerator: IEnumerable<T>;
+begin
+  Result := nil;
+end;
+
+{ TStableOrderByEnumerable<T> }
+
+function TStableOrderByEnumerable.TImpl<T>.GetEnumerator: IEnumerable<T>;
+var ResultList: TFastListRec<T>;
+begin
+
+end;
+
+class function TStableOrderByEnumerable.Create<T>(const AItems: IEnumerable<T>;
+  const AComparer: IComparer<T>): IEnumerable<T>;
+begin
+  TImpl<TObject>.Create;
+end;
+
+{ TEmptyEnumerable<T> }
+
+function TEmptyEnumerable<T>.GetEnumerator: IEnumerable<T>;
+begin
+  Result := nil;
+end;
+
+end.