mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 11:09:27 +02:00
* Properly release procdefs. Patch by Evgenij Savin, fixes issue #40844
This commit is contained in:
parent
38ec27065b
commit
adc66b233d
@ -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
12
tests/webtbs/tw40844.pp
Normal file
@ -0,0 +1,12 @@
|
||||
program tw40844;
|
||||
|
||||
{$ifdef FPC}{$mode DELPHI}{$endif}
|
||||
|
||||
uses
|
||||
uw40844a
|
||||
;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
|
19
tests/webtbs/uw40844a.pp
Normal file
19
tests/webtbs/uw40844a.pp
Normal 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
120
tests/webtbs/uw40844b.pp
Normal 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
72
tests/webtbs/uw40844c.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user