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 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
       var
         i: longint;
         i: longint;
         def: tdef;
         def: tdef;
@@ -859,9 +887,7 @@ implementation
                   unless that sym hasn't been registered either (it's possible
                   unless that sym hasn't been registered either (it's possible
                   to have one overload in the interface and another in the
                   to have one overload in the interface and another in the
                   implementation) }
                   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);
                 curr.localsymtable.deletedef(def);
               end;
               end;
           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.