* second fix for Mantis #30626: also search in parent classes for a suitable pre-existing specialization

+ added test

git-svn-id: trunk@35014 -
This commit is contained in:
svenbarth 2016-11-29 17:04:07 +00:00
parent 0a1e080089
commit 6ba85c2a70
3 changed files with 55 additions and 1 deletions

1
.gitattributes vendored
View File

@ -15256,6 +15256,7 @@ tests/webtbs/tw30552.pp svneol=native#text/pascal
tests/webtbs/tw30570.pp svneol=native#text/plain
tests/webtbs/tw30572.pp svneol=native#text/plain
tests/webtbs/tw30626.pp svneol=native#text/pascal
tests/webtbs/tw30626b.pp svneol=native#text/pascal
tests/webtbs/tw3063.pp svneol=native#text/plain
tests/webtbs/tw3064.pp svneol=native#text/plain
tests/webtbs/tw30666.pp svneol=native#text/plain

View File

@ -708,6 +708,7 @@ uses
ufinalspecializename : tidstring;
prettyname : ansistring;
generictypelist : tfphashobjectlist;
srsymtable,
specializest : tsymtable;
hashedid : thashedidstring;
tempst : tglobalsymtable;
@ -881,7 +882,17 @@ uses
begin
hashedid.id:=ufinalspecializename;
srsym:=tsym(specializest.findwithhash(hashedid));
if specializest.symtabletype=objectsymtable then
begin
{ search also in parent classes }
if not assigned(current_genericdef) or (current_genericdef.typ<>objectdef) then
internalerror(2016112901);
if not searchsym_in_class(tobjectdef(current_genericdef),tobjectdef(current_genericdef),ufinalspecializename,srsym,srsymtable,[]) then
srsym:=nil;
end
else
srsym:=tsym(specializest.findwithhash(hashedid));
if assigned(srsym) then
begin
retrieve_genericdef_or_procsym(srsym,result,psym);

42
tests/webtbs/tw30626b.pp Normal file
View File

@ -0,0 +1,42 @@
{ %NORUN }
program tw30626b;
{$mode objfpc}
type
generic IBase<T> = interface(IUnknown)
function Test: specialize IBase<T>;
end;
generic TBase<T> = class(TInterfacedObject, specialize IBase<T>)
public
function Test: specialize IBase<T>; virtual;
end;
generic TDerived<T> = class(specialize TBase<T>)
public
function Test: specialize IBase<T>; override;
end;
function TBase.Test: specialize IBase<T>;
begin
result := specialize TDerived<T>.Create;
end;
function TDerived.Test: specialize IBase<T>;
begin
result := specialize TDerived<T>.Create;
end;
type
IIntegerBase = specialize IBase<Integer>;
var
Intf, Intf2: IIntegerBase;
begin
Intf:= specialize TDerived<Integer>.Create;
Intf2:= Intf.Test;
end.