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<LongInt>;

will now have to read as

type
  TTestLongInt = SomeOtherUnit.specialize TTest<LongInt>;

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 -
This commit is contained in:
svenbarth 2015-02-20 16:23:40 +00:00
parent b2b56a4791
commit 5a344ee263
10 changed files with 414 additions and 56 deletions

4
.gitattributes vendored
View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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 "<T>" 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 "<T>" 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

15
tests/test/tgeneric100.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgeneric100;
{$mode objfpc}
uses
ugeneric99;
type
TTest1 = specialize ugeneric99.TTest<LongInt>;
begin
end.

15
tests/test/tgeneric101.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgeneric101;
{$mode objfpc}
uses
ugeneric99;
type
TTest1 = specialize TTestClass.TTest<LongInt>;
begin
end.

55
tests/test/tgeneric99.pp Normal file
View File

@ -0,0 +1,55 @@
{ %NORUN }
program tgeneric99;
{$mode objfpc}
uses
ugeneric99;
type
TTest1 = specialize TTest<LongInt>;
TTest2 = ugeneric99.specialize TTest<LongInt>;
TTest3 = TTestClass.specialize TTest<LongInt>;
TTest4 = ugeneric99.TTestClass.specialize TTest<LongInt>;
TTest5 = TTestRec.specialize TTest<LongInt>;
TTest6 = ugeneric99.TTestRec.specialize TTest<LongInt>;
var
test1: specialize TTestArray<LongInt>;
test2: ugeneric99.specialize TTestArray<LongInt>;
test3: ugeneric99.TTestClass.specialize TTestArray<LongInt>;
test4: ugeneric99.TTestRec.specialize TTestArray<LongInt>;
test5: ugeneric99.TTestClass.specialize TTest<LongInt>.TTestRec;
test6: ugeneric99.TTestRec.specialize TTest<LongInt>.TTestClass;
procedure Proc1(aArg: specialize TTestArray<LongInt>);
begin
end;
procedure Proc2(aArg: ugeneric99.specialize TTestArray<LongInt>);
begin
end;
procedure Proc3(aArg: ugeneric99.TTestClass.specialize TTestArray<LongInt>);
begin
end;
procedure Proc4(aArg: ugeneric99.TTestRec.specialize TTestArray<LongInt>);
begin
end;
procedure Proc5(aArg: ugeneric99.TTestClass.specialize TTest<LongInt>.TTestRec);
begin
end;
procedure Proc6(aArg: ugeneric99.TTestRec.specialize TTest<LongInt>.TTestClass);
begin
end;
begin
end.

47
tests/test/ugeneric99.pp Normal file
View File

@ -0,0 +1,47 @@
unit ugeneric99;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
interface
type
generic TTest<T> = class
type
TTestT = specialize TTest<T>;
end;
TTestRec = record
f: LongInt;
type
generic TTest<T> = class
type
TTestClass = class
end;
end;
generic TTestArray<T> = array of T;
var
t: specialize TTest<LongInt>.TTestClass;
end;
TTestClass = class
type
generic TTest<T> = class
type
TTestRec = record
f: LongInt;
end;
end;
generic TTestArray<T> = array of T;
var
t: specialize TTest<LongInt>.TTestRec;
end;
generic TTestArray<T> = array of T;
implementation
end.

View File

@ -14,7 +14,7 @@ type
end;
// Fatal: Internal error 200705152
TSpecialization1 = specialize TClass1.TNestedClass<Integer>;
TSpecialization1 = TClass1.specialize TNestedClass<Integer>;
begin
end.