* pgenutil.pas, generate_specialization:

* When building the typename for a generic use the full typename
	  including it's surrounding object- or abstractrecorddefs. This allows
	  that a nested non-generic type of a generic type A can be used as
	  type arguments for more than one specialization of another generic B
	  (there were some problems when B e.g. defined a pointer to the type
	  argument's type)

	* Always CRC the constructed specialization name as otherwise it might
	  reach the limit of 255 characters (not yet including unit name,
	  method name or method arguments)
	  Note: Errors like "expected XYZ, but got ABC" will need to be 
		adjusted to use the prettyname...

* increased PPU version
+ added test for above's point 1

git-svn-id: trunk@20149 -
This commit is contained in:
svenbarth 2012-01-22 13:29:12 +00:00
parent 89866cd17e
commit 7986f03186
4 changed files with 61 additions and 14 deletions

1
.gitattributes vendored
View File

@ -10340,6 +10340,7 @@ tests/test/tgeneric69.pp svneol=native#text/pascal
tests/test/tgeneric7.pp svneol=native#text/plain
tests/test/tgeneric70.pp svneol=native#text/pascal
tests/test/tgeneric71.pp svneol=native#text/pascal
tests/test/tgeneric72.pp svneol=native#text/pascal
tests/test/tgeneric8.pp svneol=native#text/plain
tests/test/tgeneric9.pp svneol=native#text/plain
tests/test/tgoto.pp svneol=native#text/plain

View File

@ -40,7 +40,7 @@ implementation
uses
{ common }
cutils,
cutils,fpccrc,
{ global }
globals,globtype,tokens,verbose,
{ symtable }
@ -64,7 +64,7 @@ uses
first,
err : boolean;
i,
gencount : longint;
gencount,crc : longint;
genericdef : tstoreddef;
generictype : ttypesym;
genericdeflist : TFPObjectList;
@ -73,9 +73,9 @@ uses
oldextendeddefs : TFPHashObjectList;
hmodule : tmodule;
pu : tused_unit;
prettyname : ansistring;
uspecializename,
countstr,genname,ugenname,specializename : string;
prettyname,specializename : ansistring;
ufinalspecializename,
countstr,genname,ugenname,finalspecializename : string;
vmtbuilder : TVMTBuilder;
specializest : tsymtable;
item : tobject;
@ -165,7 +165,7 @@ uses
if assigned(parsedtype) then
begin
genericdeflist.Add(parsedtype);
specializename:='$'+parsedtype.typesym.realname;
specializename:='$'+parsedtype.typename;
prettyname:=parsedtype.typesym.prettyname;
end
else
@ -189,7 +189,7 @@ uses
message(type_e_generics_cannot_reference_itself)
else
begin
specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
specializename:=specializename+'$'+pt2.resultdef.typename;
if first then
prettyname:=prettyname+pt2.resultdef.typesym.prettyname
else
@ -258,8 +258,9 @@ uses
genericdef:=tstoreddef(ttypesym(srsym).typedef);
{ build the new type's name }
specializename:=genname+specializename;
uspecializename:=upper(specializename);
crc:=UpdateCrc32(0,specializename[1],length(specializename));
finalspecializename:=genname+'$crc'+hexstr(crc,8);
ufinalspecializename:=upper(finalspecializename);
prettyname:=genericdef.typesym.prettyname+'<'+prettyname+'>';
{ select the symtable containing the params }
@ -295,7 +296,7 @@ uses
{ Special case if we are referencing the current defined object }
if assigned(current_structdef) and
(current_structdef.objname^=uspecializename) then
(current_structdef.objname^=ufinalspecializename) then
tt:=current_structdef;
{ decide in which symtable to put the specialization }
@ -307,7 +308,7 @@ uses
{ Can we reuse an already specialized type? }
if not assigned(tt) then
begin
hashedid.id:=uspecializename;
hashedid.id:=ufinalspecializename;
srsym:=tsym(specializest.findwithhash(hashedid));
if assigned(srsym) then
@ -387,7 +388,7 @@ uses
{ First a new typesym so we can reuse this specialization and
references to this specialization can be handled }
srsym:=ttypesym.create(specializename,generrordef);
srsym:=ttypesym.create(finalspecializename,generrordef);
specializest.insert(srsym);
{ specializations are declarations as such it is the wisest to
@ -402,7 +403,7 @@ uses
internalerror(200511171);
current_scanner.startreplaytokens(genericdef.generictokenbuf,
genericdef.change_endian);
read_named_type(tt,specializename,genericdef,generictypelist,false);
read_named_type(tt,finalspecializename,genericdef,generictypelist,false);
ttypesym(srsym).typedef:=tt;
tt.typesym:=srsym;

View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 142;
CurrentPPUVersion = 143;
{ buffer sizes }
maxentrysize = 1024;

45
tests/test/tgeneric72.pp Normal file
View File

@ -0,0 +1,45 @@
{ %NORUN }
{ This tests that the two specializations of TUsedGeneric (once with
TGeneric<LongInt>.TSubType and once with TGeneric<Pointer>.TSubType) inside
TGeneric are unique }
program tgeneric72;
{$mode objfpc}
type
generic TUsedGeneric<T> = class
type
PT = ^T;
var
f: PT;
end;
generic TGeneric<T> = class
type
TSubType = record
Field: T;
end;
PSubType = ^TSubType;
TMyUsedGeneric = specialize TUsedGeneric<TSubType>;
private
f: PSubType;
public
function GetUsedGeneric: TMyUsedGeneric;
end;
function TGeneric.GetUsedGeneric: TMyUsedGeneric;
begin
Result := TMyUsedGeneric.Create;
Result.f := f;
end;
type
TGenericLongInt = specialize TGeneric<LongInt>;
TGenericPointer = specialize TGeneric<Pointer>;
begin
end.