mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 18:09:30 +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/tw21029.pp svneol=native#text/plain
|
||||
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/tw21064b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21073.pp svneol=native#text/plain
|
||||
|
@ -237,6 +237,8 @@ type
|
||||
procedure ShowStatistics;
|
||||
procedure ForEachCall(proc2call:TListCallback;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 Count: Integer read FCount write SetCount;
|
||||
property Items[Index: Integer]: Pointer read Get write Put; default;
|
||||
@ -309,6 +311,8 @@ type
|
||||
procedure ShowStatistics; {$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 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 Count: Integer read GetCount write SetCount;
|
||||
property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
|
||||
@ -1661,6 +1665,38 @@ begin
|
||||
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
|
||||
*****************************************************************************}
|
||||
@ -1915,6 +1951,18 @@ begin
|
||||
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
|
||||
****************************************************************************}
|
||||
|
@ -2343,9 +2343,9 @@ implementation
|
||||
procedure generate_specialization_procs;
|
||||
begin
|
||||
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
|
||||
current_module.localsymtable.SymList.ForEachCall(@specialize_objectdefs,nil);
|
||||
current_module.localsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
|
||||
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