diff options
| -rw-r--r-- | compiler/defcmp.pas | 11 | ||||
| -rw-r--r-- | compiler/ptype.pas | 9 | ||||
| -rw-r--r-- | compiler/scanner.pas | 51 | ||||
| -rw-r--r-- | compiler/symdef.pas | 6 | ||||
| -rw-r--r-- | tests/test/tgeneric18.pp | 23 |
5 files changed, 75 insertions, 25 deletions
diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index f27814d4e9..2db807bd98 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -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; diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 65d6aec64a..2223a6a3c3 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 143f9c53d0..f85d023363 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index b433d9e506..ce3081b363 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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+'_'; diff --git a/tests/test/tgeneric18.pp b/tests/test/tgeneric18.pp new file mode 100644 index 0000000000..cda5aaff13 --- /dev/null +++ b/tests/test/tgeneric18.pp @@ -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. + |