mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 21:28:21 +02:00
* fix #29859: ensure that it's correctly passed down into generate_specialization whether a unit name was provided for the specialization and if so search the generic only in that unit
+ added tests
This commit is contained in:
Sven/Sarah Barth
parent
35a57bac94
commit
e050a019a2
@ -55,7 +55,8 @@ interface
|
||||
sym:tsym;
|
||||
getaddr:boolean;
|
||||
inheriteddef:tdef;
|
||||
constructor create(l:tnode;g:boolean;s:tsym);virtual;
|
||||
unit_specific:boolean;
|
||||
constructor create(l:tnode;g:boolean;s:tsym;u:boolean);virtual;
|
||||
constructor create_inherited(l:tnode;g:boolean;s:tsym;i:tdef);virtual;
|
||||
function pass_1:tnode;override;
|
||||
function pass_typecheck:tnode;override;
|
||||
@ -485,16 +486,17 @@ implementation
|
||||
TSPECIALIZENODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tspecializenode.create(l:tnode;g:boolean;s:tsym);
|
||||
constructor tspecializenode.create(l:tnode;g:boolean;s:tsym;u:boolean);
|
||||
begin
|
||||
inherited create(specializen,l);
|
||||
sym:=s;
|
||||
getaddr:=g;
|
||||
unit_specific:=u;
|
||||
end;
|
||||
|
||||
constructor tspecializenode.create_inherited(l:tnode;g:boolean;s:tsym;i:tdef);
|
||||
begin
|
||||
create(l,g,s);
|
||||
create(l,g,s,false);
|
||||
inheriteddef:=i;
|
||||
end;
|
||||
|
||||
|
||||
@ -707,6 +707,7 @@ implementation
|
||||
sym : ttypesym;
|
||||
typesrsym : tsym;
|
||||
typesrsymtable : tsymtable;
|
||||
hierarchy,
|
||||
specializename,
|
||||
prettyname: ansistring;
|
||||
error : boolean;
|
||||
@ -758,7 +759,15 @@ implementation
|
||||
exit;
|
||||
end;
|
||||
|
||||
genname:=generate_generic_name(sp,specializename,ttypesym(typesrsym).typedef.ownerhierarchyname);
|
||||
module:=find_module_from_symtable(ttypesym(typesrsym).owner);
|
||||
if not assigned(module) then
|
||||
internalerror(2022102105);
|
||||
|
||||
hierarchy:=ttypesym(typesrsym).typedef.ownerhierarchyname;
|
||||
if hierarchy<>'' then
|
||||
hierarchy:='.'+hierarchy;
|
||||
|
||||
genname:=generate_generic_name(sp,specializename,module.modulename^+hierarchy);
|
||||
ugenname:=upper(genname);
|
||||
|
||||
srsym:=search_object_name(ugenname,false);
|
||||
|
||||
@ -1592,7 +1592,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function handle_specialize_inline_specialization(var srsym:tsym;out srsymtable:tsymtable;out spezcontext:tspecializationcontext):boolean;
|
||||
function handle_specialize_inline_specialization(var srsym:tsym;enforce_unit:boolean;out srsymtable:tsymtable;out spezcontext:tspecializationcontext):boolean;
|
||||
var
|
||||
spezdef : tdef;
|
||||
symname : tsymstr;
|
||||
@ -1617,7 +1617,7 @@ implementation
|
||||
symname:=srsym.RealName
|
||||
else
|
||||
symname:='';
|
||||
spezdef:=generate_specialization_phase1(spezcontext,spezdef,symname,srsym.owner);
|
||||
spezdef:=generate_specialization_phase1(spezcontext,spezdef,enforce_unit,symname,srsym.owner);
|
||||
case spezdef.typ of
|
||||
errordef:
|
||||
begin
|
||||
@ -1721,7 +1721,7 @@ implementation
|
||||
if isspecialize then
|
||||
begin
|
||||
consume(_ID);
|
||||
if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
|
||||
if not handle_specialize_inline_specialization(srsym,false,srsymtable,spezcontext) then
|
||||
begin
|
||||
result.free;
|
||||
result:=cerrornode.create;
|
||||
@ -1764,7 +1764,7 @@ implementation
|
||||
if isspecialize and assigned(srsym) then
|
||||
begin
|
||||
consume(_ID);
|
||||
if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
|
||||
if handle_specialize_inline_specialization(srsym,false,srsymtable,spezcontext) then
|
||||
erroroutresult:=false;
|
||||
end
|
||||
else
|
||||
@ -1777,7 +1777,7 @@ implementation
|
||||
not (token in [_LT,_LSHARPBRACKET]) then
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,savedfilepos)
|
||||
else
|
||||
result:=cspecializenode.create(result,getaddr,srsym);
|
||||
result:=cspecializenode.create(result,getaddr,srsym,false);
|
||||
erroroutresult:=false;
|
||||
end
|
||||
else
|
||||
@ -2522,7 +2522,7 @@ implementation
|
||||
begin
|
||||
searchsym_in_record(structh,pattern,srsym,srsymtable);
|
||||
consume(_ID);
|
||||
if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
|
||||
if handle_specialize_inline_specialization(srsym,false,srsymtable,spezcontext) then
|
||||
erroroutp1:=false;
|
||||
end;
|
||||
end
|
||||
@ -2537,7 +2537,7 @@ implementation
|
||||
not (token in [_LT,_LSHARPBRACKET]) then
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
|
||||
else
|
||||
p1:=cspecializenode.create(p1,getaddr,srsym);
|
||||
p1:=cspecializenode.create(p1,getaddr,srsym,false);
|
||||
erroroutp1:=false;
|
||||
end
|
||||
else
|
||||
@ -2698,7 +2698,7 @@ implementation
|
||||
begin
|
||||
searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
|
||||
consume(_ID);
|
||||
if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
|
||||
if handle_specialize_inline_specialization(srsym,false,srsymtable,spezcontext) then
|
||||
erroroutp1:=false;
|
||||
end;
|
||||
end
|
||||
@ -2713,7 +2713,7 @@ implementation
|
||||
not (token in [_LT,_LSHARPBRACKET]) then
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
|
||||
else
|
||||
p1:=cspecializenode.create(p1,getaddr,srsym);
|
||||
p1:=cspecializenode.create(p1,getaddr,srsym,false);
|
||||
erroroutp1:=false;
|
||||
end
|
||||
else
|
||||
@ -2752,7 +2752,7 @@ implementation
|
||||
begin
|
||||
searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
|
||||
consume(_ID);
|
||||
if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
|
||||
if handle_specialize_inline_specialization(srsym,false,srsymtable,spezcontext) then
|
||||
erroroutp1:=false;
|
||||
end;
|
||||
end
|
||||
@ -2767,7 +2767,7 @@ implementation
|
||||
not (token in [_LT,_LSHARPBRACKET]) then
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
|
||||
else
|
||||
p1:=cspecializenode.create(p1,getaddr,srsym);
|
||||
p1:=cspecializenode.create(p1,getaddr,srsym,false);
|
||||
erroroutp1:=false;
|
||||
end
|
||||
else
|
||||
@ -3052,7 +3052,7 @@ implementation
|
||||
begin
|
||||
if block_type in [bt_type,bt_const_type,bt_var_type] then
|
||||
begin
|
||||
if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) or (srsym.typ=procsym) then
|
||||
if not handle_specialize_inline_specialization(srsym,unit_found,srsymtable,spezcontext) or (srsym.typ=procsym) then
|
||||
begin
|
||||
spezcontext.free;
|
||||
result:=cerrornode.create;
|
||||
@ -3071,7 +3071,7 @@ implementation
|
||||
end;
|
||||
end
|
||||
else
|
||||
result:=cspecializenode.create(nil,getaddr,srsym)
|
||||
result:=cspecializenode.create(nil,getaddr,srsym,unit_found)
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -3108,7 +3108,7 @@ implementation
|
||||
(sp_generic_dummy in srsym.symoptions) and
|
||||
(token in [_LT,_LSHARPBRACKET]) then
|
||||
begin
|
||||
result:=cspecializenode.create(nil,getaddr,srsym)
|
||||
result:=cspecializenode.create(nil,getaddr,srsym,unit_found)
|
||||
end
|
||||
{ check if it's a method/class method }
|
||||
else if is_member_read(srsym,srsymtable,result,hdef) then
|
||||
@ -3380,9 +3380,11 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not unit_found then
|
||||
srsymtable:=nil;
|
||||
{$push}
|
||||
{$warn 5036 off}
|
||||
hdef:=generate_specialization_phase1(spezcontext,nil,nil,orgstoredpattern,nil,dummypos);
|
||||
hdef:=generate_specialization_phase1(spezcontext,nil,unit_found,nil,orgstoredpattern,srsymtable,dummypos);
|
||||
{$pop}
|
||||
if hdef=generrordef then
|
||||
begin
|
||||
@ -3818,7 +3820,7 @@ implementation
|
||||
searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
|
||||
if isspecialize and assigned(srsym) then
|
||||
begin
|
||||
if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
|
||||
if not handle_specialize_inline_specialization(srsym,false,srsymtable,spezcontext) then
|
||||
srsym:=nil;
|
||||
end;
|
||||
end;
|
||||
@ -4406,7 +4408,8 @@ implementation
|
||||
function generate_inline_specialization(gendef:tdef;n:tnode;filepos:tfileposinfo;parseddef:tdef;gensym:tsym;p2:tnode):tnode;
|
||||
var
|
||||
again,
|
||||
getaddr : boolean;
|
||||
getaddr,
|
||||
unitspecific : boolean;
|
||||
pload : tnode;
|
||||
spezcontext : tspecializationcontext;
|
||||
structdef,
|
||||
@ -4418,6 +4421,7 @@ implementation
|
||||
getaddr:=tspecializenode(n).getaddr;
|
||||
pload:=tspecializenode(n).left;
|
||||
inheriteddef:=tabstractrecorddef(tspecializenode(n).inheriteddef);
|
||||
unitspecific:=tspecializenode(n).unit_specific;
|
||||
tspecializenode(n).left:=nil;
|
||||
end
|
||||
else
|
||||
@ -4425,12 +4429,13 @@ implementation
|
||||
getaddr:=false;
|
||||
pload:=nil;
|
||||
inheriteddef:=nil;
|
||||
unitspecific:=false;
|
||||
end;
|
||||
|
||||
if assigned(parseddef) and assigned(gensym) and assigned(p2) then
|
||||
gendef:=generate_specialization_phase1(spezcontext,gendef,parseddef,gensym.realname,gensym.owner,p2.fileinfo)
|
||||
gendef:=generate_specialization_phase1(spezcontext,gendef,unitspecific,parseddef,gensym.realname,gensym.owner,p2.fileinfo)
|
||||
else
|
||||
gendef:=generate_specialization_phase1(spezcontext,gendef);
|
||||
gendef:=generate_specialization_phase1(spezcontext,gendef,unitspecific);
|
||||
case gendef.typ of
|
||||
errordef:
|
||||
begin
|
||||
|
||||
@ -38,18 +38,18 @@ uses
|
||||
{ symtable }
|
||||
symtype,symdef,symbase;
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);inline;
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string);inline;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;inline;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;const symname:string;symtable:tsymtable):tdef;inline;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
|
||||
procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);inline;
|
||||
procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string);inline;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean):tdef;inline;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;const symname:string;symtable:tsymtable):tdef;inline;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
|
||||
function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;
|
||||
function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
|
||||
function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
|
||||
function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
|
||||
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
|
||||
procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
|
||||
function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
|
||||
function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:ansistring):tidstring;
|
||||
procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
|
||||
procedure add_generic_dummysym(sym:tsym);
|
||||
function resolve_generic_dummysym(const name:tidstring):tsym;
|
||||
@ -641,12 +641,12 @@ uses
|
||||
end;
|
||||
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string);
|
||||
procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string);
|
||||
var
|
||||
dummypos : tfileposinfo;
|
||||
begin
|
||||
FillChar(dummypos, SizeOf(tfileposinfo), 0);
|
||||
generate_specialization(tt,parse_class_parent,_prettyname,nil,'',dummypos);
|
||||
generate_specialization(tt,enforce_unit,parse_class_parent,_prettyname,nil,'',dummypos);
|
||||
end;
|
||||
|
||||
|
||||
@ -1331,29 +1331,29 @@ uses
|
||||
callerparams.free;
|
||||
end;
|
||||
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean):tdef;
|
||||
var
|
||||
dummypos : tfileposinfo;
|
||||
{$push}
|
||||
{$warn 5036 off}
|
||||
begin
|
||||
result:=generate_specialization_phase1(context,genericdef,nil,'',nil,dummypos);
|
||||
result:=generate_specialization_phase1(context,genericdef,enforce_unit,nil,'',nil,dummypos);
|
||||
end;
|
||||
{$pop}
|
||||
|
||||
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;const symname:string;symtable:tsymtable):tdef;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;const symname:string;symtable:tsymtable):tdef;
|
||||
var
|
||||
dummypos : tfileposinfo;
|
||||
{$push}
|
||||
{$warn 5036 off}
|
||||
begin
|
||||
result:=generate_specialization_phase1(context,genericdef,nil,symname,symtable,dummypos);
|
||||
result:=generate_specialization_phase1(context,genericdef,enforce_unit,nil,symname,symtable,dummypos);
|
||||
end;
|
||||
{$pop}
|
||||
|
||||
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
|
||||
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
|
||||
var
|
||||
found,
|
||||
err : boolean;
|
||||
@ -1362,6 +1362,7 @@ uses
|
||||
countstr,genname,ugenname : string;
|
||||
tmpstack : tfpobjectlist;
|
||||
symowner : tsymtable;
|
||||
hmodule : tmodule;
|
||||
begin
|
||||
context:=nil;
|
||||
result:=nil;
|
||||
@ -1488,6 +1489,17 @@ uses
|
||||
if not found then
|
||||
found:=searchsym(ugenname,context.sym,context.symtable);
|
||||
end
|
||||
else if enforce_unit then
|
||||
begin
|
||||
if not assigned(symowner) then
|
||||
internalerror(2022102101);
|
||||
if not (symowner.symtabletype in [globalsymtable,recordsymtable]) then
|
||||
internalerror(2022102102);
|
||||
hmodule:=find_module_from_symtable(symowner);
|
||||
if not assigned(hmodule) then
|
||||
internalerror(2022102103);
|
||||
found:=searchsym_in_module(hmodule,ugenname,context.sym,context.symtable);
|
||||
end
|
||||
else
|
||||
found:=searchsym(ugenname,context.sym,context.symtable);
|
||||
|
||||
@ -1656,6 +1668,7 @@ uses
|
||||
var
|
||||
finalspecializename,
|
||||
ufinalspecializename : tidstring;
|
||||
hierarchy,
|
||||
prettyname : ansistring;
|
||||
generictypelist : tfphashobjectlist;
|
||||
srsymtable,
|
||||
@ -1705,7 +1718,17 @@ uses
|
||||
end;
|
||||
|
||||
{ build the new type's name }
|
||||
finalspecializename:=generate_generic_name(context.genname,context.specializename,genericdef.ownerhierarchyname);
|
||||
hierarchy:=genericdef.ownerhierarchyname;
|
||||
if assigned(genericdef.owner) then
|
||||
begin
|
||||
hmodule:=find_module_from_symtable(genericdef.owner);
|
||||
if not assigned(hmodule) then
|
||||
internalerror(2022102801);
|
||||
if hierarchy<>'' then
|
||||
hierarchy:='.'+hierarchy;
|
||||
hierarchy:=hmodule.modulename^+hierarchy;
|
||||
end;
|
||||
finalspecializename:=generate_generic_name(context.genname,context.specializename,hierarchy);
|
||||
ufinalspecializename:=upper(finalspecializename);
|
||||
if genericdef.typ=procdef then
|
||||
prettyname:=tprocdef(genericdef).procsym.prettyname
|
||||
@ -1926,7 +1949,6 @@ uses
|
||||
not assigned(genericdef.generictokenbuf)
|
||||
) then
|
||||
internalerror(200511171);
|
||||
hmodule:=find_module_from_symtable(genericdef.owner);
|
||||
if hmodule=nil then
|
||||
internalerror(2012051202);
|
||||
oldcurrent_filepos:=current_filepos;
|
||||
@ -2138,12 +2160,12 @@ uses
|
||||
end;
|
||||
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);
|
||||
procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);
|
||||
var
|
||||
context : tspecializationcontext;
|
||||
genericdef : tstoreddef;
|
||||
begin
|
||||
genericdef:=tstoreddef(generate_specialization_phase1(context,tt,parsedtype,symname,nil,parsedpos));
|
||||
genericdef:=tstoreddef(generate_specialization_phase1(context,tt,enforce_unit,parsedtype,symname,nil,parsedpos));
|
||||
if genericdef<>generrordef then
|
||||
genericdef:=tstoreddef(generate_specialization_phase2(context,genericdef,parse_class_parent,_prettyname));
|
||||
tt:=genericdef;
|
||||
@ -2565,7 +2587,7 @@ uses
|
||||
end;
|
||||
end;
|
||||
|
||||
function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
|
||||
function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:ansistring):tidstring;
|
||||
var
|
||||
crc : cardinal;
|
||||
begin
|
||||
@ -2577,7 +2599,7 @@ uses
|
||||
if owner_hierarchy<>'' then
|
||||
begin
|
||||
crc:=UpdateCrc32(0,owner_hierarchy[1],length(owner_hierarchy));
|
||||
result:=result+'$crc'+hexstr(crc,8);
|
||||
result:=result+'_crc'+hexstr(crc,8);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -242,7 +242,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean); forward;
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize,is_unit_specific:boolean); forward;
|
||||
|
||||
|
||||
{ def is the outermost type in which other types have to be searched
|
||||
@ -262,7 +262,8 @@ implementation
|
||||
srsym: tsym;
|
||||
srsymtable: tsymtable;
|
||||
oldsymtablestack: TSymtablestack;
|
||||
isspecialize : boolean;
|
||||
isspecialize,
|
||||
isunitspecific : boolean;
|
||||
begin
|
||||
if assigned(currentstructstack) then
|
||||
structstackindex:=currentstructstack.count-1
|
||||
@ -290,7 +291,7 @@ implementation
|
||||
symtablestack:=TSymtablestack.create;
|
||||
symtablestack.push(tabstractrecorddef(def).symtable);
|
||||
t2:=generrordef;
|
||||
id_type(t2,isforwarddef,false,false,false,srsym,srsymtable,isspecialize);
|
||||
id_type(t2,isforwarddef,false,false,false,srsym,srsymtable,isspecialize,isunitspecific);
|
||||
symtablestack.pop(tabstractrecorddef(def).symtable);
|
||||
symtablestack.free;
|
||||
symtablestack:=oldsymtablestack;
|
||||
@ -298,7 +299,7 @@ implementation
|
||||
begin
|
||||
if not allowspecialization then
|
||||
Message(parser_e_no_local_para_def);
|
||||
generate_specialization(t2,false,'');
|
||||
generate_specialization(t2,isunitspecific,false,'');
|
||||
end;
|
||||
def:=t2;
|
||||
end;
|
||||
@ -344,12 +345,12 @@ implementation
|
||||
result:=false;
|
||||
end;
|
||||
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean);
|
||||
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize,is_unit_specific:boolean);
|
||||
{ reads a type definition }
|
||||
{ to a appropriating tdef, s gets the name of }
|
||||
{ the type to allow name mangling }
|
||||
var
|
||||
is_unit_specific,not_a_type : boolean;
|
||||
not_a_type : boolean;
|
||||
pos : tfileposinfo;
|
||||
s,sorg : TIDString;
|
||||
t : ttoken;
|
||||
@ -357,6 +358,7 @@ implementation
|
||||
srsym:=nil;
|
||||
srsymtable:=nil;
|
||||
is_specialize:=false;
|
||||
is_unit_specific:=false;
|
||||
s:=pattern;
|
||||
sorg:=orgpattern;
|
||||
pos:=current_tokenpos;
|
||||
@ -478,6 +480,7 @@ implementation
|
||||
|
||||
var
|
||||
t2 : tdef;
|
||||
isunitspecific,
|
||||
isspecialize,
|
||||
dospecialize,
|
||||
again : boolean;
|
||||
@ -485,6 +488,7 @@ implementation
|
||||
srsymtable : tsymtable;
|
||||
begin
|
||||
dospecialize:=false;
|
||||
isunitspecific:=false;
|
||||
srsym:=nil;
|
||||
repeat
|
||||
again:=false;
|
||||
@ -530,7 +534,7 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
id_type(def,stoIsForwardDef in options,true,true,not dospecialize or ([stoAllowSpecialization,stoAllowTypeDef]*options=[]),srsym,srsymtable,isspecialize);
|
||||
id_type(def,stoIsForwardDef in options,true,true,not dospecialize or ([stoAllowSpecialization,stoAllowTypeDef]*options=[]),srsym,srsymtable,isspecialize,isunitspecific);
|
||||
if isspecialize and dospecialize then
|
||||
internalerror(2015021301);
|
||||
if isspecialize then
|
||||
@ -569,7 +573,7 @@ implementation
|
||||
begin
|
||||
if def.typ=forwarddef then
|
||||
def:=ttypesym(srsym).typedef;
|
||||
generate_specialization(def,stoParseClassParent in options,'');
|
||||
generate_specialization(def,isunitspecific,stoParseClassParent in options,'');
|
||||
parse_nested_types(def,stoIsForwardDef in options,[stoAllowSpecialization,stoAllowTypeDef]*options<>[],nil);
|
||||
end
|
||||
else
|
||||
@ -1226,7 +1230,7 @@ implementation
|
||||
end;
|
||||
if dospecialize then
|
||||
begin
|
||||
generate_specialization(def,false,name);
|
||||
generate_specialization(def,false,false,name);
|
||||
{ handle nested types }
|
||||
if assigned(def) then
|
||||
post_comp_expr_gendef(def);
|
||||
|
||||
49
tests/test/tgeneric108.pp
Normal file
49
tests/test/tgeneric108.pp
Normal file
@ -0,0 +1,49 @@
|
||||
program tgeneric108;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
ugeneric108a, ugeneric108b;
|
||||
|
||||
type
|
||||
TTestA = ugeneric108a.specialize TTest<LongInt>;
|
||||
TTestB = ugeneric108b.specialize TTest<LongInt>;
|
||||
|
||||
function Test1: ugeneric108a.specialize TTest<LongInt>;
|
||||
begin
|
||||
Result.f := 1;
|
||||
end;
|
||||
|
||||
function Test2: ugeneric108b.specialize TTest<LongInt>;
|
||||
begin
|
||||
Result.f := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
a1: TTestA;
|
||||
b1: TTestB;
|
||||
a2: ugeneric108a.specialize TTest<LongInt>;
|
||||
b2: ugeneric108b.specialize TTest<LongInt>;
|
||||
begin
|
||||
if a1.Test <> 1 then
|
||||
Halt(1);
|
||||
if b1.Test <> 2 then
|
||||
Halt(2);
|
||||
|
||||
if a2.Test <> 1 then
|
||||
Halt(3);
|
||||
if b2.Test <> 2 then
|
||||
Halt(4);
|
||||
|
||||
if ugeneric108a.specialize TTest<LongInt>.Test2 <> 1 then
|
||||
Halt(5);
|
||||
if ugeneric108b.specialize TTest<LongInt>.Test2 <> 2 then
|
||||
Halt(6);
|
||||
|
||||
a1 := Test1;
|
||||
if a1.f <> 1 then
|
||||
Halt(7);
|
||||
b1 := Test2;
|
||||
if b1.f <> 2 then
|
||||
Halt(8);
|
||||
end.
|
||||
32
tests/test/tgeneric109.pp
Normal file
32
tests/test/tgeneric109.pp
Normal file
@ -0,0 +1,32 @@
|
||||
program tgeneric109;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
ugeneric108b, ugeneric108a;
|
||||
|
||||
type
|
||||
TTestA = ugeneric108a.specialize TTest<LongInt>;
|
||||
TTestB = ugeneric108b.specialize TTest<LongInt>;
|
||||
|
||||
var
|
||||
a1: TTestA;
|
||||
b1: TTestB;
|
||||
a2: ugeneric108a.specialize TTest<LongInt>;
|
||||
b2: ugeneric108b.specialize TTest<LongInt>;
|
||||
begin
|
||||
if a1.Test <> 1 then
|
||||
Halt(1);
|
||||
if b1.Test <> 2 then
|
||||
Halt(2);
|
||||
|
||||
if a2.Test <> 1 then
|
||||
Halt(3);
|
||||
if b2.Test <> 2 then
|
||||
Halt(4);
|
||||
|
||||
if ugeneric108a.specialize TTest<LongInt>.Test2 <> 1 then
|
||||
Halt(5);
|
||||
if ugeneric108b.specialize TTest<LongInt>.Test2 <> 2 then
|
||||
Halt(6);
|
||||
end.
|
||||
49
tests/test/tgeneric110.pp
Normal file
49
tests/test/tgeneric110.pp
Normal file
@ -0,0 +1,49 @@
|
||||
program tgeneric110;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
ugeneric108a, ugeneric108b;
|
||||
|
||||
type
|
||||
TTestA = ugeneric108a.TTest<LongInt>;
|
||||
TTestB = ugeneric108b.TTest<LongInt>;
|
||||
|
||||
function Test1: ugeneric108a.TTest<LongInt>;
|
||||
begin
|
||||
Result.f := 1;
|
||||
end;
|
||||
|
||||
function Test2: ugeneric108b.TTest<LongInt>;
|
||||
begin
|
||||
Result.f := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
a1: TTestA;
|
||||
b1: TTestB;
|
||||
a2: ugeneric108a.TTest<LongInt>;
|
||||
b2: ugeneric108b.TTest<LongInt>;
|
||||
begin
|
||||
if a1.Test <> 1 then
|
||||
Halt(1);
|
||||
if b1.Test <> 2 then
|
||||
Halt(2);
|
||||
|
||||
if a2.Test <> 1 then
|
||||
Halt(3);
|
||||
if b2.Test <> 2 then
|
||||
Halt(4);
|
||||
|
||||
if ugeneric108a.TTest<LongInt>.Test2 <> 1 then
|
||||
Halt(5);
|
||||
if ugeneric108b.TTest<LongInt>.Test2 <> 2 then
|
||||
Halt(6);
|
||||
|
||||
a1 := Test1;
|
||||
if a1.f <> 1 then
|
||||
Halt(7);
|
||||
b1 := Test2;
|
||||
if b1.f <> 2 then
|
||||
Halt(8);
|
||||
end.
|
||||
49
tests/test/tgeneric111.pp
Normal file
49
tests/test/tgeneric111.pp
Normal file
@ -0,0 +1,49 @@
|
||||
program tgeneric111;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
ugeneric108b, ugeneric108a;
|
||||
|
||||
type
|
||||
TTestA = ugeneric108a.TTest<LongInt>;
|
||||
TTestB = ugeneric108b.TTest<LongInt>;
|
||||
|
||||
function Test1: ugeneric108a.TTest<LongInt>;
|
||||
begin
|
||||
Result.f := 1;
|
||||
end;
|
||||
|
||||
function Test2: ugeneric108b.TTest<LongInt>;
|
||||
begin
|
||||
Result.f := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
a1: TTestA;
|
||||
b1: TTestB;
|
||||
a2: ugeneric108a.TTest<LongInt>;
|
||||
b2: ugeneric108b.TTest<LongInt>;
|
||||
begin
|
||||
if a1.Test <> 1 then
|
||||
Halt(1);
|
||||
if b1.Test <> 2 then
|
||||
Halt(2);
|
||||
|
||||
if a2.Test <> 1 then
|
||||
Halt(3);
|
||||
if b2.Test <> 2 then
|
||||
Halt(4);
|
||||
|
||||
if ugeneric108a.TTest<LongInt>.Test2 <> 1 then
|
||||
Halt(5);
|
||||
if ugeneric108b.TTest<LongInt>.Test2 <> 2 then
|
||||
Halt(6);
|
||||
|
||||
a1 := Test1;
|
||||
if a1.f <> 1 then
|
||||
Halt(7);
|
||||
b1 := Test2;
|
||||
if b1.f <> 2 then
|
||||
Halt(8);
|
||||
end.
|
||||
28
tests/test/ugeneric108a.pp
Normal file
28
tests/test/ugeneric108a.pp
Normal file
@ -0,0 +1,28 @@
|
||||
unit ugeneric108a;
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch advancedrecords}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
generic TTest<T> = record
|
||||
f: T;
|
||||
function Test: LongInt;
|
||||
class function Test2: LongInt; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TTest.Test: LongInt;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
class function TTest.Test2: LongInt;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
28
tests/test/ugeneric108b.pp
Normal file
28
tests/test/ugeneric108b.pp
Normal file
@ -0,0 +1,28 @@
|
||||
unit ugeneric108b;
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch advancedrecords}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
generic TTest<T> = record
|
||||
f: T;
|
||||
function Test: LongInt;
|
||||
class function Test2: LongInt; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TTest.Test: LongInt;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
class function TTest.Test2: LongInt;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
17
tests/webtbs/tw29859.pp
Normal file
17
tests/webtbs/tw29859.pp
Normal file
@ -0,0 +1,17 @@
|
||||
unit tw29859;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uw29859a, uw29859b;
|
||||
|
||||
type
|
||||
TMyIntegerRecord = uw29859a.TMyRecord<Integer>;
|
||||
TMyBooleanRecord = uw29859b.TMyRecord<Boolean>;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
22
tests/webtbs/uw29859a.pp
Normal file
22
tests/webtbs/uw29859a.pp
Normal file
@ -0,0 +1,22 @@
|
||||
unit uw29859a;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TMyRecord<T> = record
|
||||
public
|
||||
FValue: T;
|
||||
class operator Add(A,B: TMyRecord<T>): TMyRecord<T>;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class operator TMyRecord<T>.Add(A,B: TMyRecord<T>): TMyRecord<T>;
|
||||
begin
|
||||
Result.FValue := A.FValue + B.FValue;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
22
tests/webtbs/uw29859b.pp
Normal file
22
tests/webtbs/uw29859b.pp
Normal file
@ -0,0 +1,22 @@
|
||||
unit uw29859b;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TMyRecord<T> = record
|
||||
public
|
||||
FValue: T;
|
||||
class operator LogicalAnd(A: TMyRecord<T>; B: Boolean): TMyRecord<T>;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class operator TMyRecord<T>.LogicalAnd(A: TMyRecord<T>; B: Boolean): TMyRecord<T>;
|
||||
begin
|
||||
Result.FValue := A.FValue and B;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user