From 5a344ee26373ee13a0ef71813b7cfcbc46efcb08 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 20 Feb 2015 16:23:40 +0000 Subject: [PATCH] Rework the way how "specialize" is handled. Instead of initializing the specialization of a full type declaration (including unit name and parent types) it is now considered part of the specialized type itself. This means that for example the following code: type TTestLongInt = specialize SomeOtherUnit.TTest; will now have to read as type TTestLongInt = SomeOtherUnit.specialize TTest; While this is not backwards compatible this situation should arise seldomly enough and the benefits especially in context with generic functions/procedures/methods outway the drawbacks. pbase.pas: * try_consume_unitsym: add a allow_specialize parameter that allows to parse "specialize" in front of a non-unit symbol; whether it was a specialization or not is reported using a new is_specialize parameter + add a new overload try_consume_unitsym_no_specialize that calls try_consume_unit sym with allow_specialize=false and a dummy is_specialize parameter * switch calls to try_consume_unitsym to try_consume_unitsym_no_specialize pstatmnt.pas, try_statement: * switch call to try_consume_unitsym to try_consume_unitsym_no_specialize * adjust call to parse_nested_types ptype.pas: + extend id_type with the possibility to disallow unit symbols (needed if a specialize was already parsed) and to report whether a specialize was parsed + extend parse_nested_types with the possibility to tell it whether specializations are allowed * have parse_nested_types specialize generic defs if one is encountered and local type defs are allowed * id_type: only allow "unitsym.specialize sym" or "specialize sym", but not "specialize unitsym.sym" * single_type: correctly handle specializations with "specialize" keyword * read_named_type.expr_type: there is no longer a need to check for "specialize" keyword pexpr.pas: + new function handle_specialize_inline_specialization which tries to specialize a type symbol * handle_factor_typenode: handle specializations after a point that follows a record or object (why isn't this part of postfixoperators anyway? O.o) * postfixoperators: handle "specialize" after records and objectdefs * factor_read_id: handle "specialize" in front of an identifier (and after unit symbols) + added tests * adjusted test webtbs/tw16090.pp git-svn-id: trunk@29768 - --- .gitattributes | 4 + compiler/pbase.pas | 27 ++++- compiler/pexpr.pas | 238 +++++++++++++++++++++++++++++++++----- compiler/pstatmnt.pas | 4 +- compiler/ptype.pas | 63 +++++++--- tests/test/tgeneric100.pp | 15 +++ tests/test/tgeneric101.pp | 15 +++ tests/test/tgeneric99.pp | 55 +++++++++ tests/test/ugeneric99.pp | 47 ++++++++ tests/webtbs/tw16090.pp | 2 +- 10 files changed, 414 insertions(+), 56 deletions(-) create mode 100644 tests/test/tgeneric100.pp create mode 100644 tests/test/tgeneric101.pp create mode 100644 tests/test/tgeneric99.pp create mode 100644 tests/test/ugeneric99.pp diff --git a/.gitattributes b/.gitattributes index 76ef2ce2a1..11d01fcbf8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -11652,6 +11652,8 @@ tests/test/tgenconstraint8.pp svneol=native#text/pascal tests/test/tgenconstraint9.pp svneol=native#text/pascal tests/test/tgeneric1.pp svneol=native#text/plain tests/test/tgeneric10.pp svneol=native#text/plain +tests/test/tgeneric100.pp svneol=native#text/pascal +tests/test/tgeneric101.pp svneol=native#text/pascal tests/test/tgeneric11.pp svneol=native#text/plain tests/test/tgeneric12.pp svneol=native#text/plain tests/test/tgeneric13.pp svneol=native#text/plain @@ -11748,6 +11750,7 @@ tests/test/tgeneric95.pp svneol=native#text/pascal tests/test/tgeneric96.pp svneol=native#text/pascal tests/test/tgeneric97.pp svneol=native#text/pascal tests/test/tgeneric98.pp svneol=native#text/pascal +tests/test/tgeneric99.pp svneol=native#text/pascal tests/test/tgoto.pp svneol=native#text/plain tests/test/theap.pp svneol=native#text/plain tests/test/theapthread.pp svneol=native#text/plain @@ -12395,6 +12398,7 @@ tests/test/ugeneric96a.pp svneol=native#text/pascal tests/test/ugeneric96b.pp svneol=native#text/pascal tests/test/ugeneric96c.pp svneol=native#text/pascal tests/test/ugeneric96d.pp svneol=native#text/pascal +tests/test/ugeneric99.pp svneol=native#text/pascal tests/test/uhintdir.pp svneol=native#text/plain tests/test/uhlp3.pp svneol=native#text/pascal tests/test/uhlp31.pp svneol=native#text/pascal diff --git a/compiler/pbase.pas b/compiler/pbase.pas index 92d6e99c9d..3c812adfc1 100644 --- a/compiler/pbase.pas +++ b/compiler/pbase.pas @@ -89,7 +89,8 @@ interface function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean; function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean; - function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean; + function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id,allow_specialize:boolean;out is_specialize:boolean):boolean; + function try_consume_unitsym_no_specialize(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean; function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean; @@ -204,7 +205,7 @@ implementation end; searchsym(pattern,srsym,srsymtable); { handle unit specification like System.Writeln } - try_consume_unitsym(srsym,srsymtable,t,true); + try_consume_unitsym_no_specialize(srsym,srsymtable,t,true); { if nothing found give error and return errorsym } if assigned(srsym) then check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg) @@ -237,7 +238,7 @@ implementation end; searchsym(pattern,srsym,srsymtable); { handle unit specification like System.Writeln } - try_consume_unitsym(srsym,srsymtable,t,true); + try_consume_unitsym_no_specialize(srsym,srsymtable,t,true); { if nothing found give error and return errorsym } if assigned(srsym) then check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg) @@ -253,7 +254,7 @@ implementation end; - function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean; + function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id,allow_specialize:boolean;out is_specialize:boolean):boolean; var hmodule: tmodule; ns:ansistring; @@ -261,6 +262,7 @@ implementation begin result:=false; tokentoconsume:=_ID; + is_specialize:=false; if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then begin @@ -320,7 +322,15 @@ implementation searchsym_in_module(tunitsym(srsym).module,'ANSICHAR',srsym,srsymtable) end else - searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable); + if allow_specialize and (idtoken=_SPECIALIZE) then + begin + consume(_ID); + is_specialize:=true; + if token=_ID then + searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable); + end + else + searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable); _STRING: begin { system.string? } @@ -350,6 +360,13 @@ implementation end; + function try_consume_unitsym_no_specialize(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean; + var + dummy: Boolean; + begin + result:=try_consume_unitsym(srsym,srsymtable,tokentoconsume,consume_id,false,dummy); + end; + function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean; var last_is_deprecated:boolean; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index f8af2be543..4803390741 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1361,10 +1361,37 @@ implementation end; end; + + function handle_specialize_inline_specialization(var srsym:tsym;out srsymtable:tsymtable):boolean; + var + spezdef : tdef; + begin + result:=false; + if not assigned(srsym) then + message1(sym_e_id_no_member,orgpattern) + else + if srsym.typ<>typesym then + message(type_e_type_id_expected) + else + begin + spezdef:=ttypesym(srsym).typedef; + generate_specialization(spezdef,false,''); + if spezdef<>generrordef then + begin + srsym:=spezdef.typesym; + srsymtable:=srsym.owner; + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + result:=true; + end + end; + end; + + function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode; var srsym : tsym; srsymtable : tsymtable; + isspecialize : boolean; begin if sym=nil then sym:=hdef.typesym; @@ -1396,12 +1423,37 @@ implementation begin result:=ctypenode.create(hdef); ttypenode(result).typesym:=sym; + if not (m_delphi in current_settings.modeswitches) and + (block_type in [bt_type,bt_var_type,bt_const_type]) and + (token=_ID) and + (idtoken=_SPECIALIZE) then + begin + consume(_ID); + if token<>_ID then + message(type_e_type_id_expected); + isspecialize:=true; + end + else + isspecialize:=false; { search also in inherited methods } searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,[ssf_search_helper]); - if assigned(srsym) then - check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); - consume(_ID); - do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[]); + if isspecialize then + begin + consume(_ID); + if not handle_specialize_inline_specialization(srsym,srsymtable) then + begin + result.free; + result:=cerrornode.create; + end; + end + else + begin + if assigned(srsym) then + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + end; + if result.nodetype<>errorn then + do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[]); end else begin @@ -1410,17 +1462,42 @@ implementation * static methods and variables } result:=ctypenode.create(hdef); ttypenode(result).typesym:=sym; + if not (m_delphi in current_settings.modeswitches) and + (block_type in [bt_type,bt_var_type,bt_const_type]) and + (token=_ID) and + (idtoken=_SPECIALIZE) then + begin + consume(_ID); + if token<>_ID then + message(type_e_type_id_expected); + isspecialize:=true; + end + else + isspecialize:=false; { TP allows also @TMenu.Load if Load is only } { defined in an anchestor class } srsym:=search_struct_member(tabstractrecorddef(hdef),pattern); - if assigned(srsym) then + if isspecialize then begin - check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); consume(_ID); - do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]); + if not handle_specialize_inline_specialization(srsym,srsymtable) then + begin + result.free; + result:=cerrornode.create; + end; end else - Message1(sym_e_id_no_member,orgpattern); + begin + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + end + else + Message1(sym_e_id_no_member,orgpattern); + end; + if (result.nodetype<>errorn) and assigned(srsym) then + do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]); end; end else @@ -1761,6 +1838,9 @@ implementation { shouldn't be used that often, so the extra overhead is ok to save stack space } dispatchstring : ansistring; + erroroutp1, + allowspecialize, + isspecialize, found, haderror, nodechanged : boolean; @@ -1973,6 +2053,14 @@ implementation _POINT : begin consume(_POINT); + allowspecialize:=not (m_delphi in current_settings.modeswitches) and (block_type in [bt_type,bt_var_type,bt_const_type]); + if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then + begin + //consume(_ID); + isspecialize:=true; + end + else + isspecialize:=false; if (p1.resultdef.typ=pointerdef) and (m_autoderef in current_settings.modeswitches) and { don't auto-deref objc.id, because then the code @@ -2105,24 +2193,47 @@ implementation case p1.resultdef.typ of recorddef: begin - if token=_ID then + if isspecialize or (token=_ID) then begin + erroroutp1:=true; structh:=tabstractrecorddef(p1.resultdef); - searchsym_in_record(structh,pattern,srsym,srsymtable); - if assigned(srsym) then + if isspecialize then begin - check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + { consume the specialize } consume(_ID); - do_member_read(structh,getaddr,srsym,p1,again,[]); + if token<>_ID then + consume(_ID) + else + begin + searchsym_in_record(structh,pattern,srsym,srsymtable); + consume(_ID); + if handle_specialize_inline_specialization(srsym,srsymtable) then + erroroutp1:=false; + end; end else begin - Message1(sym_e_id_no_member,orgpattern); - p1.destroy; - p1:=cerrornode.create; - { try to clean up } - consume(_ID); + searchsym_in_record(structh,pattern,srsym,srsymtable); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + erroroutp1:=false; + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + { try to clean up } + consume(_ID); + end; end; + if erroroutp1 then + begin + p1.free; + p1:=cerrornode.create; + end + else + do_member_read(structh,getaddr,srsym,p1,again,[]); end else consume(_ID); @@ -2254,24 +2365,47 @@ implementation end; objectdef: begin - if token=_ID then + if isspecialize or (token=_ID) then begin + erroroutp1:=true; structh:=tobjectdef(p1.resultdef); - searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]); - if assigned(srsym) then + if isspecialize then begin - check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); - consume(_ID); - do_member_read(structh,getaddr,srsym,p1,again,[]); + { consume the "specialize" } + consume(_ID); + if token<>_ID then + consume(_ID) + else + begin + searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]); + consume(_ID); + if handle_specialize_inline_specialization(srsym,srsymtable) then + erroroutp1:=false; + end; end else begin - Message1(sym_e_id_no_member,orgpattern); - p1.destroy; - p1:=cerrornode.create; - { try to clean up } - consume(_ID); + searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + erroroutp1:=false; + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + { try to clean up } + consume(_ID); + end; end; + if erroroutp1 then + begin + p1.free; + p1:=cerrornode.create; + end + else + do_member_read(structh,getaddr,srsym,p1,again,[]); end else { Error } Consume(_ID); @@ -2449,6 +2583,8 @@ implementation storedpattern: string; callflags: tcallnodeflags; t : ttoken; + allowspecialize, + isspecialize, unit_found : boolean; tokenpos: tfileposinfo; begin @@ -2459,6 +2595,15 @@ implementation tokenpos:=current_filepos; p1:=nil; + allowspecialize:=not (m_delphi in current_settings.modeswitches) and (block_type in [bt_type,bt_var_type,bt_const_type]); + if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then + begin + consume(_ID); + isspecialize:=true; + end + else + isspecialize:=false; + { first check for identifier } if token<>_ID then begin @@ -2474,7 +2619,13 @@ implementation else searchsym(pattern,srsym,srsymtable); { handle unit specification like System.Writeln } - unit_found:=try_consume_unitsym(srsym,srsymtable,t,true); + if not isspecialize then + unit_found:=try_consume_unitsym(srsym,srsymtable,t,true,allowspecialize,isspecialize) + else + begin + unit_found:=false; + t:=_ID; + end; storedpattern:=pattern; orgstoredpattern:=orgpattern; { store the position of the token before consuming it } @@ -2484,6 +2635,7 @@ implementation found_arg_name:=false; if not(unit_found) and + not isspecialize and named_args_allowed and (token=_ASSIGNMENT) then begin @@ -2493,6 +2645,32 @@ implementation exit; end; + if isspecialize then + begin + if not assigned(srsym) or + (srsym.typ<>typesym) then + begin + identifier_not_found(orgstoredpattern,tokenpos); + srsym:=generrorsym; + srsymtable:=nil; + end + else + begin + hdef:=ttypesym(srsym).typedef; + generate_specialization(hdef,false,''); + if hdef=generrordef then + begin + srsym:=generrorsym; + srsymtable:=nil; + end + else + begin + srsym:=hdef.typesym; + srsymtable:=srsym.owner; + end; + end; + end; + { check hints, but only if it isn't a potential generic symbol; that is checked in sub_expr if it isn't a generic } if assigned(srsym) and diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 8479cef0c9..7a72bfb4d9 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -948,7 +948,7 @@ implementation with "e: Exception" the e is not necessary } { support unit.identifier } - unit_found:=try_consume_unitsym(srsym,srsymtable,t,false); + unit_found:=try_consume_unitsym_no_specialize(srsym,srsymtable,t,false); if srsym=nil then begin identifier_not_found(orgpattern); @@ -961,7 +961,7 @@ implementation if (srsym.typ=typesym) then begin ot:=ttypesym(srsym).typedef; - parse_nested_types(ot,false,nil); + parse_nested_types(ot,false,false,nil); check_type_valid(ot); end else diff --git a/compiler/ptype.pas b/compiler/ptype.pas index e099261edf..d6c4b58adf 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -50,7 +50,7 @@ interface procedure read_anon_type(var def : tdef;parseprocvardir:boolean); { parse nested type declaration of the def (typedef) } - procedure parse_nested_types(var def: tdef; isforwarddef: boolean; currentstructstack: tfpobjectlist); + procedure parse_nested_types(var def: tdef; isforwarddef,allowspecialization: boolean; currentstructstack: tfpobjectlist); { add a definition for a method to a record/objectdef that will contain @@ -200,7 +200,7 @@ implementation end; - procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); forward; + procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean); forward; { def is the outermost type in which other types have to be searched @@ -213,13 +213,14 @@ implementation being parsed (so using id_type on them after pushing def on the symtablestack would result in errors because they'd come back as errordef) } - procedure parse_nested_types(var def: tdef; isforwarddef: boolean; currentstructstack: tfpobjectlist); + procedure parse_nested_types(var def: tdef; isforwarddef,allowspecialization: boolean; currentstructstack: tfpobjectlist); var t2: tdef; structstackindex: longint; srsym: tsym; srsymtable: tsymtable; oldsymtablestack: TSymtablestack; + isspecialize : boolean; begin if assigned(currentstructstack) then structstackindex:=currentstructstack.count-1 @@ -247,10 +248,16 @@ implementation symtablestack:=TSymtablestack.create; symtablestack.push(tabstractrecorddef(def).symtable); t2:=generrordef; - id_type(t2,isforwarddef,false,false,srsym,srsymtable); + id_type(t2,isforwarddef,false,false,false,srsym,srsymtable,isspecialize); symtablestack.pop(tabstractrecorddef(def).symtable); symtablestack.free; symtablestack:=oldsymtablestack; + if isspecialize then + begin + if not allowspecialization then + Message(parser_e_no_local_para_def); + generate_specialization(t2,false,''); + end; def:=t2; end; end @@ -285,7 +292,7 @@ implementation structdefstack.add(structdef); structdef:=tabstractrecorddef(structdef.owner.defowner); end; - parse_nested_types(def,isfowarddef,structdefstack); + parse_nested_types(def,isfowarddef,false,structdefstack); structdefstack.free; result:=true; exit; @@ -295,7 +302,7 @@ implementation result:=false; end; - procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); + procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean); { reads a type definition } { to a appropriating tdef, s gets the name of } { the type to allow name mangling } @@ -307,6 +314,7 @@ implementation begin srsym:=nil; srsymtable:=nil; + is_specialize:=false; s:=pattern; sorg:=orgpattern; pos:=current_tokenpos; @@ -315,6 +323,14 @@ implementation if checkcurrentrecdef and try_parse_structdef_nested_type(def,current_structdef,isforwarddef) then exit; + if not allowunitsym and (idtoken=_SPECIALIZE) then + begin + consume(_ID); + is_specialize:=true; + s:=pattern; + sorg:=orgpattern; + pos:=current_tokenpos; + end; { Use the special searchsym_type that search only types } if not searchsym_type(s,srsym,srsymtable) then { for a good error message we need to know whether the symbol really did not exist or @@ -323,7 +339,13 @@ implementation else not_a_type:=false; { handle unit specification like System.Writeln } - is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t,true); + if allowunitsym then + is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t,true,true,is_specialize) + else + begin + t:=_ID; + is_unit_specific:=false; + end; consume(t); if not_a_type then begin @@ -399,6 +421,7 @@ implementation procedure single_type(var def:tdef;options:TSingleTypeOptions); var t2 : tdef; + isspecialize, dospecialize, again : boolean; srsym : tsym; @@ -450,8 +473,12 @@ implementation end else begin - id_type(def,stoIsForwardDef in options,true,true,srsym,srsymtable); - parse_nested_types(def,stoIsForwardDef in options,nil); + id_type(def,stoIsForwardDef in options,true,true,not dospecialize or ([stoAllowSpecialization,stoAllowTypeDef]*options=[]),srsym,srsymtable,isspecialize); + if isspecialize and dospecialize then + internalerror(2015021301); + if isspecialize then + dospecialize:=true; + parse_nested_types(def,stoIsForwardDef in options,[stoAllowSpecialization,stoAllowTypeDef]*options<>[],nil); end; end; @@ -480,7 +507,7 @@ implementation if def.typ=forwarddef then def:=ttypesym(srsym).typedef; generate_specialization(def,stoParseClassParent in options,''); - parse_nested_types(def,stoIsForwardDef in options,nil); + parse_nested_types(def,stoIsForwardDef in options,[stoAllowSpecialization,stoAllowTypeDef]*options<>[],nil); end else begin @@ -979,12 +1006,9 @@ implementation if (token=_ID) then if try_parse_structdef_nested_type(def,current_structdef,false) then exit; - { Generate a specialization in FPC mode? } - dospecialize:=not(m_delphi in current_settings.modeswitches) and try_to_consume(_SPECIALIZE); { we can't accept a equal in type } pt1:=comp_expr(false,true); - if not dospecialize and - try_to_consume(_POINTPOINT) then + if try_to_consume(_POINTPOINT) then begin { get high value of range } pt2:=comp_expr(false,false); @@ -1040,10 +1064,13 @@ implementation if (m_delphi in current_settings.modeswitches) then dospecialize:=token=_LSHARPBRACKET else - { in non-Delphi modes we might get a inline specialization - without "specialize" or "" of the same type we're - currently parsing, so we need to handle that special } - newdef:=nil; + begin + dospecialize:=false; + { in non-Delphi modes we might get a inline specialization + without "specialize" or "" of the same type we're + currently parsing, so we need to handle that special } + newdef:=nil; + end; if not dospecialize and assigned(ttypenode(pt1).typesym) and (ttypenode(pt1).typesym.typ=typesym) and diff --git a/tests/test/tgeneric100.pp b/tests/test/tgeneric100.pp new file mode 100644 index 0000000000..222a48984c --- /dev/null +++ b/tests/test/tgeneric100.pp @@ -0,0 +1,15 @@ +{ %FAIL } + +program tgeneric100; + +{$mode objfpc} + +uses + ugeneric99; + +type + TTest1 = specialize ugeneric99.TTest; + +begin + +end. diff --git a/tests/test/tgeneric101.pp b/tests/test/tgeneric101.pp new file mode 100644 index 0000000000..b674917d86 --- /dev/null +++ b/tests/test/tgeneric101.pp @@ -0,0 +1,15 @@ +{ %FAIL } + +program tgeneric101; + +{$mode objfpc} + +uses + ugeneric99; + +type + TTest1 = specialize TTestClass.TTest; + +begin + +end. diff --git a/tests/test/tgeneric99.pp b/tests/test/tgeneric99.pp new file mode 100644 index 0000000000..b92a33720a --- /dev/null +++ b/tests/test/tgeneric99.pp @@ -0,0 +1,55 @@ +{ %NORUN } + +program tgeneric99; + +{$mode objfpc} + +uses + ugeneric99; + +type + TTest1 = specialize TTest; + TTest2 = ugeneric99.specialize TTest; + + TTest3 = TTestClass.specialize TTest; + TTest4 = ugeneric99.TTestClass.specialize TTest; + + TTest5 = TTestRec.specialize TTest; + TTest6 = ugeneric99.TTestRec.specialize TTest; + +var + test1: specialize TTestArray; + test2: ugeneric99.specialize TTestArray; + + test3: ugeneric99.TTestClass.specialize TTestArray; + test4: ugeneric99.TTestRec.specialize TTestArray; + + test5: ugeneric99.TTestClass.specialize TTest.TTestRec; + test6: ugeneric99.TTestRec.specialize TTest.TTestClass; + +procedure Proc1(aArg: specialize TTestArray); +begin +end; + +procedure Proc2(aArg: ugeneric99.specialize TTestArray); +begin +end; + +procedure Proc3(aArg: ugeneric99.TTestClass.specialize TTestArray); +begin +end; + +procedure Proc4(aArg: ugeneric99.TTestRec.specialize TTestArray); +begin +end; + +procedure Proc5(aArg: ugeneric99.TTestClass.specialize TTest.TTestRec); +begin +end; + +procedure Proc6(aArg: ugeneric99.TTestRec.specialize TTest.TTestClass); +begin +end; + +begin +end. diff --git a/tests/test/ugeneric99.pp b/tests/test/ugeneric99.pp new file mode 100644 index 0000000000..469b5da0be --- /dev/null +++ b/tests/test/ugeneric99.pp @@ -0,0 +1,47 @@ +unit ugeneric99; + +{$mode objfpc}{$H+} +{$modeswitch advancedrecords} + +interface + +type + generic TTest = class + type + TTestT = specialize TTest; + end; + + TTestRec = record + f: LongInt; + type + generic TTest = class + type + TTestClass = class + end; + end; + + generic TTestArray = array of T; + var + t: specialize TTest.TTestClass; + end; + + TTestClass = class + type + generic TTest = class + type + TTestRec = record + f: LongInt; + end; + end; + + generic TTestArray = array of T; + var + t: specialize TTest.TTestRec; + end; + + generic TTestArray = array of T; + +implementation + +end. + diff --git a/tests/webtbs/tw16090.pp b/tests/webtbs/tw16090.pp index 9210d10aed..0448e57570 100644 --- a/tests/webtbs/tw16090.pp +++ b/tests/webtbs/tw16090.pp @@ -14,7 +14,7 @@ type end; // Fatal: Internal error 200705152 - TSpecialization1 = specialize TClass1.TNestedClass; + TSpecialization1 = TClass1.specialize TNestedClass; begin end.