mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 11:48:34 +02:00
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:
parent
b2b56a4791
commit
5a344ee263
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
15
tests/test/tgeneric100.pp
Normal 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
15
tests/test/tgeneric101.pp
Normal 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
55
tests/test/tgeneric99.pp
Normal 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
47
tests/test/ugeneric99.pp
Normal 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.
|
||||
|
@ -14,7 +14,7 @@ type
|
||||
end;
|
||||
|
||||
// Fatal: Internal error 200705152
|
||||
TSpecialization1 = specialize TClass1.TNestedClass<Integer>;
|
||||
TSpecialization1 = TClass1.specialize TNestedClass<Integer>;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user