mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 04:09:11 +02:00
Fix for Mantis #21051. Correctly handle specializations that occur during the specialization of methods.
cclasses.pas: + TFPHashList & TFPHashObjectList: add WhileEachCall methods that walk the list like ForEachCall does, but uses a while-loop instead of a for-loop psub.pas, generate_specialization_procs: * use WhileEachCall instead of ForEachCall as new defs can be added during the specialization that need to be specialized as well + added test git-svn-id: trunk@25577 -
This commit is contained in:
parent
b45c092186
commit
68a3827539
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -13404,6 +13404,7 @@ tests/webtbs/tw20996.pp svneol=native#text/pascal
|
|||||||
tests/webtbs/tw20998.pp svneol=native#text/pascal
|
tests/webtbs/tw20998.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw21029.pp svneol=native#text/plain
|
tests/webtbs/tw21029.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw21044.pp svneol=native#text/pascal
|
tests/webtbs/tw21044.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw21051.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw21064a.pp svneol=native#text/pascal
|
tests/webtbs/tw21064a.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw21064b.pp svneol=native#text/pascal
|
tests/webtbs/tw21064b.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw21073.pp svneol=native#text/plain
|
tests/webtbs/tw21073.pp svneol=native#text/plain
|
||||||
|
@ -237,6 +237,8 @@ type
|
|||||||
procedure ShowStatistics;
|
procedure ShowStatistics;
|
||||||
procedure ForEachCall(proc2call:TListCallback;arg:pointer);
|
procedure ForEachCall(proc2call:TListCallback;arg:pointer);
|
||||||
procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer);
|
procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer);
|
||||||
|
procedure WhileEachCall(proc2call:TListCallback;arg:pointer);
|
||||||
|
procedure WhileEachCall(proc2call:TListStaticCallback;arg:pointer);
|
||||||
property Capacity: Integer read FCapacity write SetCapacity;
|
property Capacity: Integer read FCapacity write SetCapacity;
|
||||||
property Count: Integer read FCount write SetCount;
|
property Count: Integer read FCount write SetCount;
|
||||||
property Items[Index: Integer]: Pointer read Get write Put; default;
|
property Items[Index: Integer]: Pointer read Get write Put; default;
|
||||||
@ -309,6 +311,8 @@ type
|
|||||||
procedure ShowStatistics; {$ifdef CCLASSESINLINE}inline;{$endif}
|
procedure ShowStatistics; {$ifdef CCLASSESINLINE}inline;{$endif}
|
||||||
procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
|
procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
|
||||||
procedure ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
|
procedure ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
|
||||||
|
procedure WhileEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
|
||||||
|
procedure WhileEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif}
|
||||||
property Capacity: Integer read GetCapacity write SetCapacity;
|
property Capacity: Integer read GetCapacity write SetCapacity;
|
||||||
property Count: Integer read GetCount write SetCount;
|
property Count: Integer read GetCount write SetCount;
|
||||||
property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
|
property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
|
||||||
@ -1661,6 +1665,38 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TFPHashList.WhileEachCall(proc2call:TListCallback;arg:pointer);
|
||||||
|
var
|
||||||
|
i : integer;
|
||||||
|
p : pointer;
|
||||||
|
begin
|
||||||
|
i:=0;
|
||||||
|
while i<count do
|
||||||
|
begin
|
||||||
|
p:=FHashList^[i].Data;
|
||||||
|
if assigned(p) then
|
||||||
|
proc2call(p,arg);
|
||||||
|
inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TFPHashList.WhileEachCall(proc2call:TListStaticCallback;arg:pointer);
|
||||||
|
var
|
||||||
|
i : integer;
|
||||||
|
p : pointer;
|
||||||
|
begin
|
||||||
|
i:=0;
|
||||||
|
while i<count do
|
||||||
|
begin
|
||||||
|
p:=FHashList^[i].Data;
|
||||||
|
if assigned(p) then
|
||||||
|
proc2call(p,arg);
|
||||||
|
inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TFPHashObject
|
TFPHashObject
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -1915,6 +1951,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TFPHashObjectList.WhileEachCall(proc2call:TObjectListCallback;arg:pointer);
|
||||||
|
begin
|
||||||
|
FHashList.WhileEachCall(TListCallBack(proc2call),arg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TFPHashObjectList.WhileEachCall(proc2call:TObjectListStaticCallback;arg:pointer);
|
||||||
|
begin
|
||||||
|
FHashList.WhileEachCall(TListStaticCallBack(proc2call),arg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
TLinkedListItem
|
TLinkedListItem
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
@ -2343,9 +2343,9 @@ implementation
|
|||||||
procedure generate_specialization_procs;
|
procedure generate_specialization_procs;
|
||||||
begin
|
begin
|
||||||
if assigned(current_module.globalsymtable) then
|
if assigned(current_module.globalsymtable) then
|
||||||
current_module.globalsymtable.SymList.ForEachCall(@specialize_objectdefs,nil);
|
current_module.globalsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
|
||||||
if assigned(current_module.localsymtable) then
|
if assigned(current_module.localsymtable) then
|
||||||
current_module.localsymtable.SymList.ForEachCall(@specialize_objectdefs,nil);
|
current_module.localsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
54
tests/webtbs/tw21051.pp
Normal file
54
tests/webtbs/tw21051.pp
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
{ %NORUN }
|
||||||
|
|
||||||
|
program tw21051;
|
||||||
|
|
||||||
|
{$mode Delphi}{$H+}
|
||||||
|
|
||||||
|
type
|
||||||
|
TCustomInner<T> = class abstract
|
||||||
|
protected
|
||||||
|
function SomeMethod: T; virtual; abstract;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TContainer<T> = class
|
||||||
|
public
|
||||||
|
function GetInner: TCustomInner<T>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TInner<T> = class(TCustomInner<T>)
|
||||||
|
private
|
||||||
|
FContainer: TContainer<T>;
|
||||||
|
protected
|
||||||
|
function SomeMethod: T; override;
|
||||||
|
public
|
||||||
|
constructor Create(AContainer: TContainer<T>);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TContainer<T>.GetInner: TCustomInner<T>;
|
||||||
|
type
|
||||||
|
InnerClass = TInner<T>;
|
||||||
|
begin
|
||||||
|
Result := InnerClass.Create(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TInner<T>.SomeMethod: T;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TInner<T>.Create(AContainer: TContainer<T>);
|
||||||
|
begin
|
||||||
|
FContainer := AContainer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Test;
|
||||||
|
var
|
||||||
|
C: TContainer<string>;
|
||||||
|
begin
|
||||||
|
C := TContainer<string>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Test;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user