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

This commit is contained in:
Michaël Van Canneyt 2024-07-05 14:34:52 +02:00
parent 38ec27065b
commit adc66b233d
5 changed files with 252 additions and 3 deletions

View File

@ -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
tests/webtbs/tw40844.pp Normal file
View File

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

19
tests/webtbs/uw40844a.pp Normal file
View File

@ -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
tests/webtbs/uw40844b.pp Normal file
View File

@ -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
tests/webtbs/uw40844c.pp Normal file
View File

@ -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.