* several fixes which improve the behaviour of nested generics, resolves #15077

git-svn-id: trunk@14176 -
This commit is contained in:
florian 2009-11-14 22:24:55 +00:00
parent baf01d1f40
commit 5d01732128
6 changed files with 76 additions and 25 deletions

1
.gitattributes vendored
View File

@ -8862,6 +8862,7 @@ tests/test/tgeneric14.pp svneol=native#text/plain
tests/test/tgeneric15.pp svneol=native#text/plain
tests/test/tgeneric16.pp svneol=native#text/plain
tests/test/tgeneric17.pp svneol=native#text/plain
tests/test/tgeneric18.pp svneol=native#text/pascal
tests/test/tgeneric2.pp svneol=native#text/plain
tests/test/tgeneric3.pp svneol=native#text/plain
tests/test/tgeneric4.pp svneol=native#text/plain

View File

@ -198,16 +198,7 @@ implementation
(def_to.typ=undefineddef) then
begin
doconv:=tc_equal;
compare_defs_ext:=te_equal;
exit;
end;
{ undefined def? then mark it as equal }
if (def_from.typ=undefineddef) or
(def_to.typ=undefineddef) then
begin
doconv:=tc_equal;
compare_defs_ext:=te_equal;
compare_defs_ext:=te_exact;
exit;
end;

View File

@ -141,7 +141,6 @@ implementation
end;
procedure generate_specialization(var tt:tdef);
var
st : TSymtable;
@ -175,10 +174,13 @@ implementation
onlyparsepara:=true;
end;
{ Only need to record the tokens, then we don't know the type yet }
{ only need to record the tokens, then we don't know the type yet ... }
if parse_generic then
begin
tt:=cundefinedtype;
{ ... but we have to insert a def into the symtable else the deflist
of generic and specialization might not be equally sized which
is later assumed }
tt:=tundefineddef.create;
onlyparsepara:=true;
end;
@ -317,6 +319,7 @@ implementation
{ Consume the semicolon if it is also recorded }
try_to_consume(_SEMICOLON);
{ Build VMT indexes for classes }
if (tt.typ=objectdef) then
begin

View File

@ -65,6 +65,15 @@ interface
constructor CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc);
end;
// stack for replay buffers
treplaystack = class
token : ttoken;
settings : tsettings;
tokenbuf : tdynamicarray;
next : treplaystack;
constructor Create(atoken: ttoken;asettings:tsettings;atokenbuf:tdynamicarray;anext:treplaystack);
end;
tcompile_time_predicate = function(var valuedescr: String) : Boolean;
tspecialgenerictoken = (ST_LOADSETTINGS,ST_LINE,ST_COLUMN,ST_FILEINDEX);
@ -97,12 +106,9 @@ interface
oldcurrent_tokenpos : tfileposinfo;
replaysavetoken : ttoken;
replaytokenbuf,
recordtokenbuf : tdynamicarray;
{ old settings, i.e. settings specialization was started }
old_settings,
{ last settings we stored }
last_settings : tsettings;
@ -116,6 +122,7 @@ interface
lastasmgetchar : char;
ignoredirectives : TFPHashList; { ignore directives, used to give warnings only once }
preprocstack : tpreprocstack;
replaystack : treplaystack;
in_asm_string : boolean;
preproc_pattern : string;
@ -146,6 +153,7 @@ interface
procedure ifpreprocstack(atyp : preproctyp;compile_time_predicate:tcompile_time_predicate;messid:longint);
procedure elseifpreprocstack(compile_time_predicate:tcompile_time_predicate);
procedure elsepreprocstack;
procedure popreplaystack;
procedure handleconditional(p:tdirectiveitem);
procedure handledirectives;
procedure linebreak;
@ -1818,6 +1826,16 @@ In case not, the value returned can be arbitrary.
next:=n;
end;
{*****************************************************************************
TReplayStack
*****************************************************************************}
constructor treplaystack.Create(atoken:ttoken;asettings:tsettings;atokenbuf:tdynamicarray;anext:treplaystack);
begin
token:=atoken;
settings:=asettings;
tokenbuf:=atokenbuf;
next:=anext;
end;
{*****************************************************************************
TDirectiveItem
@ -1853,6 +1871,7 @@ In case not, the value returned can be arbitrary.
inputstart:=0;
{ reset scanner }
preprocstack:=nil;
replaystack:=nil;
comment_level:=0;
yylexcount:=0;
block_type:=bt_general;
@ -1888,6 +1907,8 @@ In case not, the value returned can be arbitrary.
while assigned(preprocstack) do
poppreprocstack;
end;
while assigned(replaystack) do
popreplaystack;
if not inputfile.closed then
closeinputfile;
ignoredirectives.free;
@ -2094,8 +2115,7 @@ In case not, the value returned can be arbitrary.
{ save current token }
if token in [_CWCHAR,_CWSTRING,_CCHAR,_CSTRING,_INTCONST,_REALNUMBER,_ID] then
internalerror(200511178);
replaysavetoken:=token;
old_settings:=current_settings;
replaystack:=treplaystack.create(token,current_settings,replaytokenbuf,replaystack);
if assigned(inputpointer) then
dec(inputpointer);
{ install buffer }
@ -2117,15 +2137,16 @@ In case not, the value returned can be arbitrary.
{ End of replay buffer? Then load the next char from the file again }
if replaytokenbuf.pos>=replaytokenbuf.size then
begin
replaytokenbuf:=nil;
token:=replaystack.token;
replaytokenbuf:=replaystack.tokenbuf;
{ restore compiler settings }
current_settings:=replaystack.settings;
popreplaystack;
if assigned(inputpointer) then
begin
c:=inputpointer^;
inc(inputpointer);
end;
token:=replaysavetoken;
{ restore compiler settings }
current_settings:=old_settings;
exit;
end;
repeat
@ -2549,6 +2570,18 @@ In case not, the value returned can be arbitrary.
end;
procedure tscannerfile.popreplaystack;
var
hp : treplaystack;
begin
if assigned(replaystack) then
begin
hp:=replaystack.next;
replaystack.free;
replaystack:=hp;
end;
end;
procedure tscannerfile.handleconditional(p:tdirectiveitem);
begin
savetokenpos;

View File

@ -862,8 +862,8 @@ implementation
prefix:=s;
st:=st.defowner.owner;
end;
{ object/classes symtable }
if (st.symtabletype=ObjectSymtable) then
{ object/classes symtable, nested type definitions in classes require the while loop }
while st.symtabletype=ObjectSymtable do
begin
if st.defowner.typ<>objectdef then
internalerror(200204174);
@ -872,7 +872,7 @@ implementation
end;
{ symtable must now be static or global }
if not(st.symtabletype in [staticsymtable,globalsymtable]) then
internalerror(200204175);
internalerror(200204175);
result:='';
if typeprefix<>'' then
result:=result+typeprefix+'_';

23
tests/test/tgeneric18.pp Normal file
View File

@ -0,0 +1,23 @@
program tgeneric18;
{$mode objfpc}{$H+}
type
{ TFirstGeneric }
generic TFirstGeneric<T> = class(TObject)
end;
{ TSecondGeneric }
generic TSecondGeneric<T> = class(TObject)
type public
TFirstGenericType = specialize TFirstGeneric<T>;
end;
var
Second: specialize TSecondGeneric<string>;
begin
end.