paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/z80@45131 -
This commit is contained in:
nickysn 2020-04-26 22:33:58 +00:00
commit 6f6598712f
69 changed files with 2205 additions and 832 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
.gitattributes vendored
View File

@ -14782,6 +14782,36 @@ tests/test/tfpu5.pp svneol=native#text/plain
tests/test/tfpuover.pp svneol=native#text/plain
tests/test/tfwork1.pp svneol=native#text/plain
tests/test/tfwork2.pp svneol=native#text/plain
tests/test/tgenconst1.pp svneol=native#text/pascal
tests/test/tgenconst10.pp svneol=native#text/pascal
tests/test/tgenconst11.pp svneol=native#text/pascal
tests/test/tgenconst12.pp svneol=native#text/pascal
tests/test/tgenconst13.pp svneol=native#text/pascal
tests/test/tgenconst14.pp svneol=native#text/pascal
tests/test/tgenconst15.pp svneol=native#text/pascal
tests/test/tgenconst16.pp svneol=native#text/pascal
tests/test/tgenconst17.pp svneol=native#text/pascal
tests/test/tgenconst18.pp svneol=native#text/pascal
tests/test/tgenconst19.pp svneol=native#text/pascal
tests/test/tgenconst2.pp svneol=native#text/pascal
tests/test/tgenconst20.pp svneol=native#text/pascal
tests/test/tgenconst21.pp svneol=native#text/pascal
tests/test/tgenconst22.pp svneol=native#text/pascal
tests/test/tgenconst23.pp svneol=native#text/pascal
tests/test/tgenconst24.pp svneol=native#text/pascal
tests/test/tgenconst25.pp svneol=native#text/pascal
tests/test/tgenconst26.pp svneol=native#text/pascal
tests/test/tgenconst27.pp svneol=native#text/pascal
tests/test/tgenconst28.pp svneol=native#text/pascal
tests/test/tgenconst29.pp svneol=native#text/pascal
tests/test/tgenconst3.pp svneol=native#text/pascal
tests/test/tgenconst30.pp svneol=native#text/pascal
tests/test/tgenconst4.pp svneol=native#text/pascal
tests/test/tgenconst5.pp svneol=native#text/pascal
tests/test/tgenconst6.pp svneol=native#text/pascal
tests/test/tgenconst7.pp svneol=native#text/pascal
tests/test/tgenconst8.pp svneol=native#text/pascal
tests/test/tgenconst9.pp svneol=native#text/pascal
tests/test/tgenconstraint1.pp svneol=native#text/pascal
tests/test/tgenconstraint10.pp svneol=native#text/pascal
tests/test/tgenconstraint11.pp svneol=native#text/pascal
@ -16411,6 +16441,7 @@ tests/webtbf/tw36631b.pp svneol=native#text/pascal
tests/webtbf/tw36652.pp svneol=native#text/pascal
tests/webtbf/tw36720.pp svneol=native#text/pascal
tests/webtbf/tw3680.pp svneol=native#text/plain
tests/webtbf/tw36975.pp svneol=native#text/pascal
tests/webtbf/tw3716.pp svneol=native#text/plain
tests/webtbf/tw3738.pp svneol=native#text/plain
tests/webtbf/tw3740.pp svneol=native#text/plain

8
compiler/defcmp.pas
View File

@ -345,9 +345,13 @@ implementation
internalerror(2012091302);
symfrom:=ttypesym(tstoreddef(def_from).genericparas[i]);
symto:=ttypesym(tstoreddef(def_to).genericparas[i]);
if not (symfrom.typ=typesym) or not (symto.typ=typesym) then
if not (symfrom.typ in [typesym,constsym]) or not (symto.typ in [typesym,constsym]) then
internalerror(2012121401);
if not equal_defs(ttypesym(symfrom).typedef,ttypesym(symto).typedef) then
if symto.typ<>symfrom.typ then
diff:=true
else if (symfrom.typ=constsym) and (symto.typ=constsym) and not equal_constsym(tconstsym(symfrom),tconstsym(symto),true) then
diff:=true
else if not equal_defs(ttypesym(symfrom).typedef,ttypesym(symto).typedef) then
diff:=true;
if diff then
break;

2
compiler/htypechk.pas
View File

@ -2779,7 +2779,7 @@ implementation
internalerror(2015060301);
{ check whether the given parameters are compatible
to the def's constraints }
if not check_generic_constraints(pd,spezcontext.genericdeflist,spezcontext.poslist) then
if not check_generic_constraints(pd,spezcontext.paramlist,spezcontext.poslist) then
exit;
def:=generate_specialization_phase2(spezcontext,pd,false,'');
case def.typ of

5
compiler/msg/errore.msg
View File

@ -1617,7 +1617,7 @@ parser_e_generic_constraints_not_allowed_here=03355_E_Generic constraint not all
%
# Type Checking
#
# 04127 is the last used one
# 04128 is the last used one
#
% \section{Type checking errors}
% This section lists all errors that can occur when type checking is
@ -2061,6 +2061,9 @@ type_e_forward_interface_type_does_not_match=04127_E_The interface type of the f
% When declaring an interface forward, the interface type must be the same as at the actual declaration of the interface.
% This is in particular important with regard to the parent interface which implicitly sets the interface type for the
% child interface.
type_e_generic_const_type_not_allowed=04128_E_Type not allowed for generic constant parameter: $1
% Only types that can also be used (indirectly) for untyped constants can be used as a
% type for a generic constant parameter.
% \end{description}
#
# Symtable

5
compiler/msgidx.inc
View File

@ -584,6 +584,7 @@ const
type_w_empty_constant_range_set=04125;
type_e_cblock_callconv=04126;
type_e_forward_interface_type_does_not_match=04127;
type_e_generic_const_type_not_allowed=04128;
sym_e_id_not_found=05000;
sym_f_internal_error_in_symtablestack=05001;
sym_e_duplicate_id=05002;
@ -1125,9 +1126,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 85143;
MsgTxtSize = 85203;
MsgIdxMax : array[1..20] of longint=(
28,106,356,128,99,63,143,36,223,68,
28,106,356,129,99,63,143,36,223,68,
62,20,30,1,1,1,1,1,1,1
);

1006
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

4
compiler/ncnv.pas
View File

@ -3102,7 +3102,8 @@ implementation
{ for constant values on absolute variables, swapping is required }
if (target_info.endian = endian_big) and (nf_absolute in flags) then
swap_const_value(tordconstnode(left).value,tordconstnode(left).resultdef.size);
adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
if not(nf_generic_para in flags) then
adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
{ swap value back, but according to new type }
if (target_info.endian = endian_big) and (nf_absolute in flags) then
swap_const_value(tordconstnode(left).value,resultdef.size);
@ -3219,6 +3220,7 @@ implementation
end;
if (convtype=tc_int_2_int) and (left.nodetype=typeconvn) and (ttypeconvnode(left).convtype=tc_bool_2_int) then
begin
ttypeconvnode(left).totypedef:=resultdef;
ttypeconvnode(left).resultdef:=resultdef;
result:=left;
left:=nil;

41
compiler/ncon.pas
View File

@ -306,6 +306,7 @@ implementation
p1 : tnode;
len : longint;
pc : pchar;
value_set : pconstset;
begin
p1:=nil;
case p.consttyp of
@ -331,18 +332,50 @@ implementation
constwstring :
p1:=cstringconstnode.createunistr(pcompilerwidestring(p.value.valueptr));
constreal :
p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,p.constdef);
begin
if (sp_generic_para in p.symoptions) and not (sp_generic_const in p.symoptions) then
p1:=crealconstnode.create(default(bestreal),p.constdef)
else
p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,p.constdef);
end;
constset :
p1:=csetconstnode.create(pconstset(p.value.valueptr),p.constdef);
begin
if sp_generic_const in p.symoptions then
begin
new(value_set);
value_set^:=pconstset(p.value.valueptr)^;
p1:=csetconstnode.create(value_set,p.constdef);
end
else if sp_generic_para in p.symoptions then
begin
new(value_set);
p1:=csetconstnode.create(value_set,p.constdef);
end
else
p1:=csetconstnode.create(pconstset(p.value.valueptr),p.constdef);
end;
constpointer :
p1:=cpointerconstnode.create(p.value.valueordptr,p.constdef);
begin
if sp_generic_para in p.symoptions then
p1:=cpointerconstnode.create(default(tconstptruint),p.constdef)
else
p1:=cpointerconstnode.create(p.value.valueordptr,p.constdef);
end;
constnil :
p1:=cnilnode.create;
constguid :
p1:=cguidconstnode.create(pguid(p.value.valueptr)^);
begin
if sp_generic_para in p.symoptions then
p1:=cguidconstnode.create(default(tguid))
else
p1:=cguidconstnode.create(pguid(p.value.valueptr)^);
end;
else
internalerror(200205103);
end;
{ transfer generic param flag from symbol to node }
if sp_generic_para in p.symoptions then
include(p1.flags,nf_generic_para);
genconstsymtree:=p1;
end;

5
compiler/nmat.pas
View File

@ -131,7 +131,10 @@ implementation
end;
if rv = 0 then
begin
Message(parser_e_division_by_zero);
{ if the node is derived from a generic const parameter
then don't issue an error }
if not (nf_generic_para in flags) then
Message(parser_e_division_by_zero);
{ recover }
tordconstnode(right).value := 1;
end;

20
compiler/node.pas
View File

@ -276,10 +276,13 @@ interface
nf_block_with_exit,
{ tloadvmtaddrnode }
nf_ignore_for_wpo { we know that this loadvmtaddrnode cannot be used to construct a class instance }
nf_ignore_for_wpo, { we know that this loadvmtaddrnode cannot be used to construct a class instance }
{ WARNING: there are now 31 elements in this type, and a set of this
type is written to the PPU. So before adding more than 32 elements,
{ node is derived from generic parameter }
nf_generic_para
{ WARNING: there are now 32 elements in this type, and a set of this
type is written to the PPU. So before adding more elements,
either move some flags to specific nodes, or stream a normalset
to the ppu
}
@ -1380,6 +1383,9 @@ implementation
constructor tunarynode.create(t:tnodetype;l : tnode);
begin
inherited create(t);
{ transfer generic paramater flag }
if assigned(l) and (nf_generic_para in l.flags) then
include(flags,nf_generic_para);
left:=l;
end;
@ -1482,7 +1488,10 @@ implementation
constructor tbinarynode.create(t:tnodetype;l,r : tnode);
begin
inherited create(t,l);
right:=r
{ transfer generic paramater flag }
if assigned(r) and (nf_generic_para in r.flags) then
include(flags,nf_generic_para);
right:=r;
end;
@ -1635,6 +1644,9 @@ implementation
constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode);
begin
inherited create(_t,l,r);
{ transfer generic parameter flag }
if assigned(t) and (nf_generic_para in t.flags) then
include(flags,nf_generic_para);
third:=t;
end;

5
compiler/nset.pas
View File

@ -424,8 +424,9 @@ implementation
{ both types must be compatible }
if compare_defs(left.resultdef,right.resultdef,left.nodetype)=te_incompatible then
IncompatibleTypes(left.resultdef,right.resultdef);
{ Check if only when its a constant set }
if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
{ check if only when its a constant set and
ignore range nodes which are generic parameter derived }
if not (nf_generic_para in flags) and (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
begin
{ upper limit must be greater or equal than lower limit }
if (tordconstnode(left).value>tordconstnode(right).value) and

5
compiler/pass_1.pas
View File

@ -62,6 +62,7 @@ implementation
procedure typecheckpass_internal_loop(var p : tnode; out node_changed: boolean);
var
hp : tnode;
oldflags : tnodeflags;
begin
codegenerror:=false;
repeat
@ -73,9 +74,13 @@ implementation
if assigned(hp) then
begin
node_changed:=true;
oldflags:=p.flags;
p.free;
{ switch to new node }
p:=hp;
{ transfer generic paramter flag }
if nf_generic_para in oldflags then
include(p.flags,nf_generic_para);
end;
until not assigned(hp) or
assigned(hp.resultdef);

26
compiler/pdecl.pas
View File

@ -135,7 +135,10 @@ implementation
setconstn :
begin
new(ps);
ps^:=tsetconstnode(p).value_set^;
if assigned(tsetconstnode(p).value_set) then
ps^:=tsetconstnode(p).value_set^
else
ps^:=[];
hp:=cconstsym.create_ptr(orgname,constset,ps,p.resultdef);
end;
pointerconstn :
@ -185,8 +188,22 @@ implementation
end;
end;
else
Message(parser_e_illegal_expression);
begin
{ the node is from a generic parameter constant and is
untyped so we need to pass a placeholder constant
instead of givng an error }
if nf_generic_para in p.flags then
hp:=cconstsym.create_ord(orgname,constnil,0,p.resultdef)
else
Message(parser_e_illegal_expression);
end;
end;
{ transfer generic param flag from node to symbol }
if nf_generic_para in p.flags then
begin
include(hp.symoptions,sp_generic_const);
include(hp.symoptions,sp_generic_para);
end;
current_tokenpos:=storetokenpos;
p.free;
readconstant:=hp;
@ -716,8 +733,9 @@ implementation
{ we are not freeing the type parameters, so register them }
for i:=0 to generictypelist.count-1 do
begin
ttypesym(generictypelist[i]).register_sym;
tstoreddef(ttypesym(generictypelist[i]).typedef).register_def;
tstoredsym(generictypelist[i]).register_sym;
if tstoredsym(generictypelist[i]).typ=typesym then
tstoreddef(ttypesym(generictypelist[i]).typedef).register_def;
end;
str(generictypelist.Count,s);

32
compiler/pdecsub.pas
View File

@ -628,7 +628,7 @@ implementation
for i:=0 to genericparams.count-1 do
begin
sym:=ttypesym(genericparams[i]);
if tstoreddef(sym.typedef).is_registered then
if (sym.typ<>constsym) and tstoreddef(sym.typedef).is_registered then
begin
sym.typedef.free;
sym.typedef:=nil;
@ -813,9 +813,11 @@ implementation
function check_generic_parameters(def:tstoreddef):boolean;
var
i : longint;
decltype,
impltype : ttypesym;
declsym,
implsym : tsym;
impltype : ttypesym absolute implsym;
implname : tsymstr;
fileinfo : tfileposinfo;
begin
result:=true;
if not assigned(def.genericparas) then
@ -826,18 +828,23 @@ implementation
internalerror(2018090104);
for i:=0 to def.genericparas.count-1 do
begin
decltype:=ttypesym(def.genericparas[i]);
impltype:=ttypesym(genericparams[i]);
declsym:=tsym(def.genericparas[i]);
implsym:=tsym(genericparams[i]);
implname:=upper(genericparams.nameofindex(i));
if decltype.name<>implname then
if declsym.name<>implname then
begin
messagepos1(impltype.fileinfo,sym_e_generic_type_param_mismatch,impltype.realname);
messagepos1(decltype.fileinfo,sym_e_generic_type_param_decl,decltype.realname);
messagepos1(implsym.fileinfo,sym_e_generic_type_param_mismatch,implsym.realname);
messagepos1(declsym.fileinfo,sym_e_generic_type_param_decl,declsym.realname);
result:=false;
end;
if df_genconstraint in impltype.typedef.defoptions then
if ((implsym.typ=typesym) and (df_genconstraint in impltype.typedef.defoptions)) or
(implsym.typ=constsym) then
begin
messagepos(tstoreddef(impltype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
if implsym.typ=constsym then
fileinfo:=impltype.fileinfo
else
fileinfo:=tstoreddef(impltype.typedef).genconstraintdata.fileinfo;
messagepos(fileinfo,parser_e_generic_constraints_not_allowed_here);
result:=false;
end;
end;
@ -1127,8 +1134,9 @@ implementation
{ register the parameters }
for i:=0 to genericparams.count-1 do
begin
ttypesym(genericparams[i]).register_sym;
tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
tsym(genericparams[i]).register_sym;
if tsym(genericparams[i]).typ=typesym then
tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
end;
insert_generic_parameter_types(pd,nil,genericparams);
{ the list is no longer required }

4
compiler/pdecvar.pas
View File

@ -1707,6 +1707,10 @@ implementation
hdef:=generrordef;
end;
{ field type is a generic param so set a flag in the struct }
if assigned(hdef.typesym) and (sp_generic_para in hdef.typesym.symoptions) then
include(current_structdef.defoptions,df_has_generic_fields);
{ Process procvar directives }
if maybe_parse_proc_directives(hdef) then
semicoloneaten:=true;

17
compiler/pexpr.pas
View File

@ -447,6 +447,9 @@ implementation
{ no packed bit support for these things }
if l=in_bitsizeof_x then
statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
{ type sym is a generic parameter }
if assigned(p1.resultdef.typesym) and (sp_generic_para in p1.resultdef.typesym.symoptions) then
include(statement_syssym.flags,nf_generic_para);
end
else
begin
@ -467,6 +470,9 @@ implementation
end
else
statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sizesinttype,true);
{ type def is a struct with generic fields }
if df_has_generic_fields in p1.resultdef.defoptions then
include(statement_syssym.flags,nf_generic_para);
{ p1 not needed !}
p1.destroy;
end;
@ -4247,7 +4253,10 @@ implementation
gendef:=generate_specialization_phase2(spezcontext,tstoreddef(gendef),false,'');
spezcontext.free;
spezcontext:=nil;
gensym:=gendef.typesym;
if gendef.typ=errordef then
gensym:=generrorsym
else
gensym:=gendef.typesym;
end;
procdef:
begin
@ -4601,7 +4610,7 @@ implementation
filepos : tfileposinfo;
oldafterassignment,
updatefpos : boolean;
oldflags : tnodeflags;
begin
oldafterassignment:=afterassignment;
p1:=sub_expr(opcompare,[ef_accept_equal],nil);
@ -4658,10 +4667,14 @@ implementation
else
updatefpos:=false;
end;
oldflags:=p1.flags;
{ get the resultdef for this expression }
if not assigned(p1.resultdef) and
dotypecheck then
do_typecheckpass(p1);
{ transfer generic paramter flag }
if nf_generic_para in oldflags then
include(p1.flags,nf_generic_para);
afterassignment:=oldafterassignment;
if updatefpos then
p1.fileinfo:=filepos;

6
compiler/pgentype.pas
View File

@ -42,7 +42,7 @@ type
tspecializationcontext=class
public
genericdeflist : tfpobjectlist;
paramlist : tfpobjectlist;
poslist : tfplist;
prettyname : ansistring;
specializename : ansistring;
@ -58,7 +58,7 @@ implementation
constructor tspecializationcontext.create;
begin
genericdeflist:=tfpobjectlist.create(false);
paramlist:=tfpobjectlist.create(false);
poslist:=tfplist.create;
end;
@ -66,7 +66,7 @@ destructor tspecializationcontext.destroy;
var
i : longint;
begin
genericdeflist.free;
paramlist.free;
for i:=0 to poslist.count-1 do
dispose(pfileposinfo(poslist[i]));
poslist.free;

705
compiler/pgenutil.pas
View File

@ -42,9 +42,9 @@ uses
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string):tdef;inline;
function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;parsedpos:tfileposinfo):tdef;
function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
function check_generic_constraints(genericdef:tstoreddef;paradeflist:tfpobjectlist;poslist:tfplist):boolean;
function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
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);
procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
function generate_generic_name(const name:tidstring;specializename:ansistring;owner_hierarchy:string):tidstring;
@ -65,16 +65,148 @@ uses
{ common }
cutils,fpccrc,
{ global }
globals,tokens,verbose,finput,
globals,tokens,verbose,finput,constexp,
{ symtable }
symconst,symsym,symtable,defcmp,procinfo,
symconst,symsym,symtable,defcmp,defutil,procinfo,
{ modules }
fmodule,
node,nobj,
node,nobj,ncon,
{ parser }
scanner,
pbase,pexpr,pdecsub,ptype,psub,pparautl;
type
tdeftypeset = set of tdeftyp;
const
tgeneric_param_const_types : tdeftypeset = [orddef,stringdef,floatdef,setdef,pointerdef,enumdef];
tgeneric_param_nodes : tnodetypeset = [typen,ordconstn,stringconstn,realconstn,setconstn,niln];
function get_generic_param_def(sym:tsym):tdef;
begin
if sym.typ=constsym then
result:=tconstsym(sym).constdef
else
result:=ttypesym(sym).typedef;
end;
function compare_orddef_by_range(param1,param2:torddef;value:tconstvalue):boolean;
begin
if (value.valueord<param2.low) or (value.valueord>param2.high) then
result:=false
else
result:=true;
end;
function compare_generic_params(param1,param2:tdef;constparamsym:tconstsym):boolean;
begin
if (param1.typ=orddef) and (param2.typ=orddef) then
begin
if is_boolean(param2) then
result:=is_boolean(param1)
else if is_char(param2) then
result:=is_char(param1)
else if compare_orddef_by_range(torddef(param1),torddef(param2),constparamsym.value) then
result:=true
else
result:=false;
end
{ arraydef is string constant so it's compatible with stringdef }
else if (param1.typ=arraydef) and (param2.typ=stringdef) then
result:=true
{ integer ords are compatible with float }
else if (param1.typ=orddef) and is_integer(param1) and (param2.typ=floatdef) then
result:=true
{ undefined def is compatible with all types }
else if param2.typ=undefineddef then
result:=true
{ sets require stricter checks }
else if is_set(param2) then
result:=equal_defs(param1,param2)
else
result:=param1.typ=param2.typ;
end;
function create_generic_constsym(fromdef:tdef;node:tnode;out prettyname:string):tconstsym;
const
undefinedname = 'undefined';
var
sym : tconstsym;
setdef : tsetdef;
enumsym : tsym;
enumname : string;
sp : pchar;
ps : ^tconstset;
pd : ^bestreal;
i : integer;
begin
if node=nil then
internalerror(2020011401);
case node.nodetype of
ordconstn:
begin
sym:=cconstsym.create_ord(undefinedname,constord,tordconstnode(node).value,fromdef);
prettyname:=tostr(tordconstnode(node).value.svalue);
end;
stringconstn:
begin
getmem(sp,tstringconstnode(node).len+1);
move(tstringconstnode(node).value_str^,sp^,tstringconstnode(node).len+1);
sym:=cconstsym.create_string(undefinedname,conststring,sp,tstringconstnode(node).len,fromdef);
prettyname:=''''+tstringconstnode(node).value_str+'''';
end;
realconstn:
begin
new(pd);
pd^:=trealconstnode(node).value_real;
sym:=cconstsym.create_ptr(undefinedname,constreal,pd,fromdef);
prettyname:=realtostr(trealconstnode(node).value_real);
end;
setconstn:
begin
new(ps);
ps^:=tsetconstnode(node).value_set^;
sym:=cconstsym.create_ptr(undefinedname,constset,ps,fromdef);
setdef:=tsetdef(tsetconstnode(node).resultdef);
prettyname:='[';
for i := setdef.setbase to setdef.setmax do
if i in tsetconstnode(node).value_set^ then
begin
if setdef.elementdef.typ=enumdef then
enumsym:=tenumdef(setdef.elementdef).int2enumsym(i)
else
enumsym:=nil;
if assigned(enumsym) then
enumname:=enumsym.realname
else if setdef.elementdef.typ=orddef then
begin
if torddef(setdef.elementdef).ordtype=uchar then
enumname:=chr(i)
else
enumname:=tostr(i);
end
else
enumname:=tostr(i);
if length(prettyname) > 1 then
prettyname:=prettyname+','+enumname
else
prettyname:=prettyname+enumname;
end;
prettyname:=prettyname+']';
end;
niln:
begin
{ only "nil" is available for pointer constants }
sym:=cconstsym.create_ord(undefinedname,constnil,0,fromdef);
prettyname:='nil';
end;
else
internalerror(2019021601);
end;
{ the sym needs an owner for later checks so use the typeparam owner }
sym.owner:=fromdef.owner;
include(sym.symoptions,sp_generic_const);
result:=sym;
end;
procedure maybe_add_waiting_unit(tt:tdef);
var
@ -104,203 +236,231 @@ uses
end;
end;
function check_generic_constraints(genericdef:tstoreddef;paradeflist:tfpobjectlist;poslist:tfplist):boolean;
function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
var
i,j,
intfcount : longint;
formaldef,
paradef : tstoreddef;
genparadef : tdef;
objdef,
paraobjdef,
formalobjdef : tobjectdef;
intffound : boolean;
filepos : tfileposinfo;
is_const : boolean;
begin
{ check whether the given specialization parameters fit to the eventual
constraints of the generic }
if not assigned(genericdef.genericparas) or (genericdef.genericparas.count=0) then
internalerror(2012101001);
if genericdef.genericparas.count<>paradeflist.count then
if genericdef.genericparas.count<>paramlist.count then
internalerror(2012101002);
if paradeflist.count<>poslist.count then
if paramlist.count<>poslist.count then
internalerror(2012120801);
result:=true;
for i:=0 to genericdef.genericparas.count-1 do
begin
filepos:=pfileposinfo(poslist[i])^;
formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
if formaldef.typ=undefineddef then
{ the parameter is of unspecified type, so no need to check }
continue;
if not (df_genconstraint in formaldef.defoptions) or
not assigned(formaldef.genconstraintdata) then
internalerror(2013021602);
paradef:=tstoreddef(paradeflist[i]);
{ undefineddef is compatible with anything }
if formaldef.typ=undefineddef then
continue;
if paradef.typ<>formaldef.typ then
paradef:=tstoreddef(get_generic_param_def(tsym(paramlist[i])));
is_const:=tsym(paramlist[i]).typ=constsym;
genparadef:=genericdef.get_generic_param_def(i);
{ validate const params }
if not genericdef.is_generic_param_const(i) and is_const then
begin
case formaldef.typ of
recorddef:
{ delphi has own fantasy about record constraint
(almost non-nullable/non-nilable value type) }
if m_delphi in current_settings.modeswitches then
case paradef.typ of
floatdef,enumdef,orddef:
continue;
objectdef:
if tobjectdef(paradef).objecttype=odt_object then
continue
else
MessagePos(filepos,type_e_record_type_expected);
MessagePos(filepos,type_e_mismatch);
exit(false);
end
else if genericdef.is_generic_param_const(i) then
begin
{ param type mismatch (type <> const) }
if genericdef.is_generic_param_const(i)<>is_const then
begin
MessagePos(filepos,type_e_mismatch);
exit(false);
end;
{ type constrained param doesn't match type }
if not compare_generic_params(paradef,genericdef.get_generic_param_def(i),tconstsym(paramlist[i])) then
begin
MessagePos2(filepos,type_e_incompatible_types,FullTypeName(paradef,genparadef),FullTypeName(genparadef,paradef));
exit(false);
end;
end;
{ test constraints for non-const params }
if not genericdef.is_generic_param_const(i) then
begin
formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
if formaldef.typ=undefineddef then
{ the parameter is of unspecified type, so no need to check }
continue;
if not (df_genconstraint in formaldef.defoptions) or
not assigned(formaldef.genconstraintdata) then
internalerror(2013021602);
{ undefineddef is compatible with anything }
if formaldef.typ=undefineddef then
continue;
if paradef.typ<>formaldef.typ then
begin
case formaldef.typ of
recorddef:
{ delphi has own fantasy about record constraint
(almost non-nullable/non-nilable value type) }
if m_delphi in current_settings.modeswitches then
case paradef.typ of
floatdef,enumdef,orddef:
continue;
objectdef:
if tobjectdef(paradef).objecttype=odt_object then
continue
else
MessagePos(filepos,type_e_record_type_expected);
else
MessagePos(filepos,type_e_record_type_expected);
end
else
MessagePos(filepos,type_e_record_type_expected);
end
else
MessagePos(filepos,type_e_record_type_expected);
objectdef:
case tobjectdef(formaldef).objecttype of
odt_class,
odt_javaclass:
MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
odt_interfacecom,
odt_interfacecorba,
odt_dispinterface,
odt_interfacejava:
MessagePos1(filepos,type_e_interface_type_expected,paradef.typename);
else
internalerror(2012101003);
end;
errordef:
{ ignore }
;
else
internalerror(2012101004);
end;
result:=false;
end
else
begin
{ the paradef types are the same, so do special checks for the
cases in which they are needed }
if formaldef.typ=objectdef then
begin
paraobjdef:=tobjectdef(paradef);
formalobjdef:=tobjectdef(formaldef);
if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
internalerror(2012101102);
if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
begin
{ this is either a concerete interface or class type (the
latter without specific implemented interfaces) }
case paraobjdef.objecttype of
objectdef:
case tobjectdef(formaldef).objecttype of
odt_class,
odt_javaclass:
MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
odt_interfacecom,
odt_interfacecorba,
odt_interfacejava,
odt_dispinterface:
begin
if (oo_is_forward in paraobjdef.objectoptions) and
(paraobjdef.objecttype=formalobjdef.objecttype) and
(df_genconstraint in formalobjdef.defoptions) and
(
(formalobjdef.objecttype=odt_interfacecom) and
(formalobjdef.childof=interface_iunknown)
)
or
(
(formalobjdef.objecttype=odt_interfacecorba) and
(formalobjdef.childof=nil)
) then
continue;
if not def_is_related(paraobjdef,formalobjdef.childof) then
odt_dispinterface,
odt_interfacejava:
MessagePos1(filepos,type_e_interface_type_expected,paradef.typename);
else
internalerror(2012101003);
end;
errordef:
{ ignore }
;
else
internalerror(2012101004);
end;
result:=false;
end
else
begin
{ the paradef types are the same, so do special checks for the
cases in which they are needed }
if formaldef.typ=objectdef then
begin
paraobjdef:=tobjectdef(paradef);
formalobjdef:=tobjectdef(formaldef);
if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
internalerror(2012101102);
if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
begin
{ this is either a concerete interface or class type (the
latter without specific implemented interfaces) }
case paraobjdef.objecttype of
odt_interfacecom,
odt_interfacecorba,
odt_interfacejava,
odt_dispinterface:
begin
MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
if (oo_is_forward in paraobjdef.objectoptions) and
(paraobjdef.objecttype=formalobjdef.objecttype) and
(df_genconstraint in formalobjdef.defoptions) and
(
(formalobjdef.objecttype=odt_interfacecom) and
(formalobjdef.childof=interface_iunknown)
)
or
(
(formalobjdef.objecttype=odt_interfacecorba) and
(formalobjdef.childof=nil)
) then
continue;
if not def_is_related(paraobjdef,formalobjdef.childof) then
begin
MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
result:=false;
end;
end;
odt_class,
odt_javaclass:
begin
objdef:=paraobjdef;
intffound:=false;
while assigned(objdef) do
begin
for j:=0 to objdef.implementedinterfaces.count-1 do
if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef.childof then
begin
intffound:=true;
break;
end;
if intffound then
break;
objdef:=objdef.childof;
end;
result:=intffound;
if not result then
MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
end;
else
begin
MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
result:=false;
end;
end;
odt_class,
odt_javaclass:
begin
objdef:=paraobjdef;
intffound:=false;
while assigned(objdef) do
begin
for j:=0 to objdef.implementedinterfaces.count-1 do
if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef.childof then
begin
intffound:=true;
break;
end;
if intffound then
break;
objdef:=objdef.childof;
end;
result:=intffound;
if not result then
MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
end;
else
begin
MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
result:=false;
end;
end;
end
else
begin
{ this is either a "class" or a concrete instance with
or without implemented interfaces }
if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
end
else
begin
MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
result:=false;
continue;
end;
{ for forward declared classes we allow pure TObject/class declarations }
if (oo_is_forward in paraobjdef.objectoptions) and
(df_genconstraint in formaldef.defoptions) then
begin
if (formalobjdef.childof=class_tobject) and
not formalobjdef.implements_any_interfaces then
continue;
end;
if assigned(formalobjdef.childof) and
not def_is_related(paradef,formalobjdef.childof) then
begin
MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
result:=false;
end;
intfcount:=0;
for j:=0 to formalobjdef.implementedinterfaces.count-1 do
begin
objdef:=paraobjdef;
while assigned(objdef) do
{ this is either a "class" or a concrete instance with
or without implemented interfaces }
if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
begin
intffound:=assigned(
find_implemented_interface(objdef,
timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
)
);
if intffound then
break;
objdef:=objdef.childof;
MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
result:=false;
continue;
end;
if intffound then
inc(intfcount)
else
MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
{ for forward declared classes we allow pure TObject/class declarations }
if (oo_is_forward in paraobjdef.objectoptions) and
(df_genconstraint in formaldef.defoptions) then
begin
if (formalobjdef.childof=class_tobject) and
not formalobjdef.implements_any_interfaces then
continue;
end;
if assigned(formalobjdef.childof) and
not def_is_related(paradef,formalobjdef.childof) then
begin
MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
result:=false;
end;
intfcount:=0;
for j:=0 to formalobjdef.implementedinterfaces.count-1 do
begin
objdef:=paraobjdef;
while assigned(objdef) do
begin
intffound:=assigned(
find_implemented_interface(objdef,
timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
)
);
if intffound then
break;
objdef:=objdef.childof;
end;
if intffound then
inc(intfcount)
else
MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
end;
if intfcount<>formalobjdef.implementedinterfaces.count then
result:=false;
end;
if intfcount<>formalobjdef.implementedinterfaces.count then
result:=false;
end;
end;
end;
end;
end;
function parse_generic_specialization_types_internal(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
function parse_generic_specialization_types_internal(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
var
old_block_type : tblock_type;
first : boolean;
@ -310,9 +470,11 @@ uses
namepart : string;
prettynamepart : ansistring;
module : tmodule;
constprettyname : string;
validparam : boolean;
begin
result:=true;
if genericdeflist=nil then
if paramlist=nil then
internalerror(2012061401);
{ set the block type to type, so that the parsed type are returned as
ttypenode (e.g. classes are in non type-compatible blocks returned as
@ -324,7 +486,7 @@ uses
first:=not assigned(parsedtype);
if assigned(parsedtype) then
begin
genericdeflist.Add(parsedtype);
paramlist.Add(parsedtype.typesym);
module:=find_module_from_symtable(parsedtype.owner);
if not assigned(module) then
internalerror(2016112801);
@ -350,8 +512,10 @@ uses
consume(_COMMA);
block_type:=bt_type;
tmpparampos:=current_filepos;
typeparam:=factor(false,[ef_type_only]);
if typeparam.nodetype=typen then
typeparam:=factor(false,[ef_accept_equal]);
{ determine if the typeparam node is a valid type or const }
validparam:=typeparam.nodetype in tgeneric_param_nodes;
if validparam then
begin
if tstoreddef(typeparam.resultdef).is_generic and
(
@ -367,31 +531,46 @@ uses
end;
if typeparam.resultdef.typ<>errordef then
begin
if not assigned(typeparam.resultdef.typesym) then
if (typeparam.nodetype=typen) and not assigned(typeparam.resultdef.typesym) then
message(type_e_generics_cannot_reference_itself)
else if (typeparam.resultdef.typ<>errordef) then
begin
genericdeflist.Add(typeparam.resultdef);
{ all non-type nodes are considered const }
if typeparam.nodetype<>typen then
paramlist.Add(create_generic_constsym(typeparam.resultdef,typeparam,constprettyname))
else
begin
constprettyname:='';
paramlist.Add(typeparam.resultdef.typesym);
end;
module:=find_module_from_symtable(typeparam.resultdef.owner);
if not assigned(module) then
internalerror(2016112802);
namepart:='_$'+hexstr(module.moduleid,8)+'$$'+typeparam.resultdef.unique_id_str;
if constprettyname<>'' then
namepart:=namepart+'$$'+constprettyname;
{ we use the full name of the type to uniquely identify it }
if (symtablestack.top.symtabletype=parasymtable) and
(symtablestack.top.defowner.typ=procdef) and
(typeparam.resultdef.owner=symtablestack.top) then
if typeparam.nodetype=typen then
begin
{ special handling for specializations inside generic function declarations }
prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
end
else
begin
prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
if (symtablestack.top.symtabletype=parasymtable) and
(symtablestack.top.defowner.typ=procdef) and
(typeparam.resultdef.owner=symtablestack.top) then
begin
{ special handling for specializations inside generic function declarations }
prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
end
else
begin
prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
end;
end;
specializename:=specializename+namepart;
if not first then
prettyname:=prettyname+',';
prettyname:=prettyname+prettynamepart+typeparam.resultdef.typesym.prettyname;
if constprettyname<>'' then
prettyname:=prettyname+constprettyname
else
prettyname:=prettyname+prettynamepart+typeparam.resultdef.typesym.prettyname;
end;
end
else
@ -411,12 +590,12 @@ uses
end;
function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
var
dummypos : tfileposinfo;
begin
FillChar(dummypos, SizeOf(tfileposinfo), 0);
result:=parse_generic_specialization_types_internal(genericdeflist,poslist,prettyname,specializename,nil,dummypos);
result:=parse_generic_specialization_types_internal(paramlist,poslist,prettyname,specializename,nil,dummypos);
end;
@ -502,7 +681,7 @@ uses
context:=tspecializationcontext.create;
{ Parse type parameters }
err:=not parse_generic_specialization_types_internal(context.genericdeflist,context.poslist,context.prettyname,context.specializename,parsedtype,parsedpos);
err:=not parse_generic_specialization_types_internal(context.paramlist,context.poslist,context.prettyname,context.specializename,parsedtype,parsedpos);
if err then
begin
if not try_to_consume(_GT) then
@ -556,7 +735,7 @@ uses
{ search a generic with the given count of params }
countstr:='';
str(context.genericdeflist.Count,countstr);
str(context.paramlist.Count,countstr);
genname:=genname+'$'+countstr;
ugenname:=upper(genname);
@ -681,6 +860,8 @@ uses
tempst : tglobalsymtable;
psym,
srsym : tsym;
paramdef1,
paramdef2,
def : tdef;
old_block_type : tblock_type;
state : tspecializationstate;
@ -708,7 +889,7 @@ uses
pd:=nil;
if not check_generic_constraints(genericdef,context.genericdeflist,context.poslist) then
if not check_generic_constraints(genericdef,context.paramlist,context.poslist) then
begin
{ the parameters didn't fit the constraints, so don't continue with the
specialization }
@ -724,20 +905,19 @@ uses
else
prettyname:=genericdef.typesym.prettyname;
prettyname:=prettyname+'<'+context.prettyname+'>';
generictypelist:=tfphashobjectlist.create(false);
{ build the list containing the types for the generic params }
if not assigned(genericdef.genericparas) then
internalerror(2013092601);
if context.genericdeflist.count<>genericdef.genericparas.count then
if context.paramlist.count<>genericdef.genericparas.count then
internalerror(2013092603);
for i:=0 to genericdef.genericparas.Count-1 do
begin
srsym:=tsym(genericdef.genericparas[i]);
if not (sp_generic_para in srsym.symoptions) then
internalerror(2013092602);
generictypelist.add(srsym.realname,tdef(context.genericdeflist[i]).typesym);
generictypelist.add(srsym.realname,context.paramlist[i]);
end;
{ Special case if we are referencing the current defined object }
@ -792,11 +972,33 @@ uses
allequal:=true;
for i:=0 to generictypelist.count-1 do
begin
if not equal_defs(ttypesym(generictypelist[i]).typedef,ttypesym(tstoreddef(def).genericparas[i]).typedef) then
if tsym(generictypelist[i]).typ<>tsym(tstoreddef(def).genericparas[i]).typ then
begin
allequal:=false;
break;
end;
if tsym(generictypelist[i]).typ=constsym then
paramdef1:=tconstsym(generictypelist[i]).constdef
else
paramdef1:=ttypesym(generictypelist[i]).typedef;
if tsym(tstoreddef(def).genericparas[i]).typ=constsym then
paramdef2:=tconstsym(tstoreddef(def).genericparas[i]).constdef
else
paramdef2:=ttypesym(tstoreddef(def).genericparas[i]).typedef;
if not equal_defs(paramdef2,paramdef2) then
begin
allequal:=false;
break;
end;
if (tsym(generictypelist[i]).typ=constsym) and
(
(tconstsym(generictypelist[i]).consttyp<>tconstsym(tstoreddef(def).genericparas[i]).consttyp) or
not same_constvalue(tconstsym(generictypelist[i]).consttyp,tconstsym(generictypelist[i]).value,tconstsym(tstoreddef(def).genericparas[i]).value)
) then
begin
allequal:=false;
break;
end;
end;
if allequal then
begin
@ -1159,25 +1361,43 @@ uses
function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
var
generictype : ttypesym;
i,firstidx : longint;
generictype : tstoredsym;
i,firstidx,const_list_index : longint;
srsymtable : tsymtable;
basedef,def : tdef;
defname : tidstring;
allowconst,
allowconstructor,
is_const,
doconsume : boolean;
constraintdata : tgenericconstraintdata;
old_block_type : tblock_type;
fileinfo : tfileposinfo;
last_token : ttoken;
last_type_pos : tfileposinfo;
begin
result:=tfphashobjectlist.create(false);
firstidx:=0;
const_list_index:=0;
old_block_type:=block_type;
block_type:=bt_type;
allowconst:=true;
is_const:=false;
last_token:=NOTOKEN;
last_type_pos:=current_filepos;
repeat
if allowconst and try_to_consume(_CONST) then
begin
allowconst:=false;
is_const:=true;
const_list_index:=result.count;
end;
if token=_ID then
begin
generictype:=ctypesym.create(orgpattern,cundefinedtype);
if is_const then
generictype:=cconstsym.create_undefined(orgpattern,cundefinedtype)
else
generictype:=ctypesym.create(orgpattern,cundefinedtype);
{ type parameters need to be added as strict private }
generictype.visibility:=vis_strictprivate;
include(generictype.symoptions,sp_generic_para);
@ -1185,7 +1405,43 @@ uses
end;
consume(_ID);
fileinfo:=current_tokenpos;
if try_to_consume(_COLON) then
{ const restriction }
if is_const and try_to_consume(_COLON) then
begin
def:=nil;
{ parse the type and assign the const type to generictype }
single_type(def,[]);
for i:=const_list_index to result.count-1 do
begin
{ finalize constant information once type is known }
if assigned(def) and (def.typ in tgeneric_param_const_types) then
begin
case def.typ of
orddef,
enumdef:
tconstsym(result[i]).consttyp:=constord;
stringdef:
tconstsym(result[i]).consttyp:=conststring;
floatdef:
tconstsym(result[i]).consttyp:=constreal;
setdef:
tconstsym(result[i]).consttyp:=constset;
{ pointer always refers to nil with constants }
pointerdef:
tconstsym(result[i]).consttyp:=constnil;
else
internalerror(2020011402);
end;
tconstsym(result[i]).constdef:=def;
end
else
Message1(type_e_generic_const_type_not_allowed,def.fulltypename);
end;
{ after type restriction const list terminates }
is_const:=false;
end
{ type restriction }
else if try_to_consume(_COLON) then
begin
if not allowconstraints then
Message(parser_e_generic_constraints_not_allowed_here);
@ -1302,6 +1558,7 @@ uses
basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def),false);
constraintdata.interfaces.delete(0);
end;
if basedef.typ<>errordef then
with tstoreddef(basedef) do
begin
@ -1328,21 +1585,34 @@ uses
begin
{ two different typeless parameters are considered as incompatible }
for i:=firstidx to result.count-1 do
begin
ttypesym(result[i]).typedef:=cundefineddef.create(false);
ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
end;
if tsym(result[i]).typ<>constsym then
begin
ttypesym(result[i]).typedef:=cundefineddef.create(false);
ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
end;
{ a semicolon terminates a type parameter group }
firstidx:=result.count;
end;
end;
if token=_SEMICOLON then
begin
is_const:=false;
allowconst:=true;
end;
last_token:=token;
last_type_pos:=current_filepos;
until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
{ if the constant parameter is not terminated then the type restriction was
not specified and we need to give an error }
if is_const then
consume(_COLON);
{ two different typeless parameters are considered as incompatible }
for i:=firstidx to result.count-1 do
begin
ttypesym(result[i]).typedef:=cundefineddef.create(false);
ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
end;
if tsym(result[i]).typ<>constsym then
begin
ttypesym(result[i]).typedef:=cundefineddef.create(false);
ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
end;
block_type:=old_block_type;
end;
@ -1350,7 +1620,9 @@ uses
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
var
i : longint;
generictype,sym : ttypesym;
generictype : tstoredsym;
generictypedef : tdef;
sym : tsym;
st : tsymtable;
begin
def.genericdef:=genericdef;
@ -1375,10 +1647,23 @@ uses
def.genericparas:=tfphashobjectlist.create(false);
for i:=0 to genericlist.count-1 do
begin
generictype:=ttypesym(genericlist[i]);
generictype:=tstoredsym(genericlist[i]);
if assigned(generictype.owner) then
begin
sym:=ctypesym.create(genericlist.nameofindex(i),generictype.typedef);
if generictype.typ=typesym then
sym:=ctypesym.create(genericlist.nameofindex(i),ttypesym(generictype).typedef)
else if generictype.typ=constsym then
{ generictype is a constsym that was created in create_generic_constsym
during phase 1 so we pass this directly without copying }
begin
sym:=generictype;
{ the sym name is still undefined so we set it to match
the generic param name so it's accessible }
sym.realname:=genericlist.nameofindex(i);
include(sym.symoptions,sp_generic_const);
end
else
internalerror(2019021602);
{ type parameters need to be added as strict private }
sym.visibility:=vis_strictprivate;
st.insert(sym);
@ -1386,13 +1671,17 @@ uses
end
else
begin
if (generictype.typedef.typ=undefineddef) and (generictype.typedef<>cundefinedtype) then
if generictype.typ=typesym then
begin
{ the generic parameters were parsed before the genericdef existed thus the
undefineddefs were added as part of the parent symtable }
if assigned(generictype.typedef.owner) then
generictype.typedef.owner.DefList.Extract(generictype.typedef);
generictype.typedef.changeowner(st);
generictypedef:=ttypesym(generictype).typedef;
if (generictypedef.typ=undefineddef) and (generictypedef<>cundefinedtype) then
begin
{ the generic parameters were parsed before the genericdef existed thus the
undefineddefs were added as part of the parent symtable }
if assigned(generictypedef.owner) then
generictypedef.owner.DefList.Extract(generictypedef);
generictypedef.changeowner(st);
end;
end;
st.insert(generictype);
include(generictype.symoptions,sp_generic_para);

75
compiler/pparautl.pas
View File

@ -631,27 +631,48 @@ implementation
function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
var
i : longint;
fwtype,
currtype : ttypesym;
fwsym,
currsym : tsym;
currtype : ttypesym absolute currsym;
fileinfo : tfileposinfo;
begin
result:=true;
if fwpd.genericparas.count<>currpd.genericparas.count then
internalerror(2018090101);
for i:=0 to fwpd.genericparas.count-1 do
begin
fwtype:=ttypesym(fwpd.genericparas[i]);
currtype:=ttypesym(currpd.genericparas[i]);
if fwtype.name<>currtype.name then
fwsym:=tsym(fwpd.genericparas[i]);
currsym:=tsym(currpd.genericparas[i]);
if fwsym.name<>currsym.name then
begin
messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
messagepos1(currsym.fileinfo,sym_e_generic_type_param_mismatch,currsym.realname);
messagepos1(fwsym.fileinfo,sym_e_generic_type_param_decl,fwsym.realname);
result:=false;
end;
if (fwpd.interfacedef or assigned(fwpd.struct)) and (df_genconstraint in currtype.typedef.defoptions) then
if (fwpd.interfacedef or assigned(fwpd.struct)) and
(
((currsym.typ=typesym) and (df_genconstraint in currtype.typedef.defoptions)) or
(currsym.typ=constsym)
) then
begin
messagepos(tstoreddef(currtype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
if currsym.typ=constsym then
fileinfo:=currsym.fileinfo
else
fileinfo:=tstoreddef(currtype.typedef).genconstraintdata.fileinfo;
messagepos(fileinfo,parser_e_generic_constraints_not_allowed_here);
result:=false;
end;
if not fwpd.interfacedef and not assigned(fwpd.struct) and
(fwsym.typ=constsym) then
begin
{ without modeswitch RepeatForward we need to check here
if the type of the constants match }
if (currsym.typ<>constsym) or not equal_defs(tconstsym(fwsym).constdef,tconstsym(currsym).constdef) then
begin
messagepos1(currpd.fileinfo,parser_e_header_dont_match_forward,currpd.fullprocname(false));
result:=false;
end;
end;
end;
end;
@ -659,8 +680,10 @@ implementation
function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
var
i : longint;
fwtype,
currtype : ttypesym;
fwsym,
currsym : tsym;
fwtype : ttypesym absolute fwsym;
currtype : ttypesym absolute currsym;
foundretdef : boolean;
begin
result:=false;
@ -677,14 +700,36 @@ implementation
foundretdef:=false;
for i:=0 to fwpd.genericparas.count-1 do
begin
fwtype:=ttypesym(fwpd.genericparas[i]);
currtype:=ttypesym(currpd.genericparas[i]);
fwsym:=tsym(fwpd.genericparas[i]);
currsym:=tsym(currpd.genericparas[i]);
{ if the type in the currpd isn't a pure undefineddef (thus there
are constraints and the fwpd was declared in the interface, then
we can stop right there }
if fwpd.interfacedef and ((currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions)) then
if fwpd.interfacedef and
(
(currsym.typ=constsym) or
((currsym.typ=typesym) and
(
(currtype.typedef.typ<>undefineddef) or
(df_genconstraint in currtype.typedef.defoptions)
)
)
)then
exit;
if not foundretdef then
if not fwpd.interfacedef then
begin
if (fwsym.typ=constsym) and (currsym.typ=constsym) then
begin
{ check whether the constant type for forward functions match }
if not equal_defs(tconstsym(fwsym).constdef,tconstsym(currsym).constdef) then
exit;
end
else if (fwsym.typ=constsym) then
{ if the forward sym is a constant, the implementation needs to be one
as well }
exit;
end;
if not foundretdef and (fwsym.typ=typesym) then
begin
{ if the returndef is the same as this parameter's def then this
needs to be the case for both procdefs }

2
compiler/ppu.pas
View File

@ -50,7 +50,7 @@ const
CurrentPPUVersion = 207;
{ for any other changes to the ppu format, increase this version number
(it's a cardinal) }
CurrentPPULongVersion = 8;
CurrentPPULongVersion = 9;
{ unit flags }
uf_big_endian = $000004;

4
compiler/pstatmnt.pas
View File

@ -361,7 +361,9 @@ implementation
procedure check_range(hp:tnode; fordef: tdef);
begin
if (hp.nodetype=ordconstn) and
(fordef.typ<>errordef) then
(fordef.typ<>errordef) and
{ the node was derived from a generic parameter so ignore range check }
not(nf_generic_para in hp.flags) then
adaptrange(fordef,tordconstnode(hp).value,false,false,true);
end;

12
compiler/ptype.pas
View File

@ -1316,6 +1316,7 @@ implementation
procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:tfphashobjectlist);
var
isgeneric : boolean;
lowval,
highval : TConstExprInt;
indexdef : tdef;
@ -1362,6 +1363,7 @@ implementation
lowval:=0;
highval:=1;
indexdef:=def;
isgeneric:=true;
end;
else
Message(sym_e_error_in_type_def);
@ -1409,6 +1411,7 @@ implementation
begin
{ defaults }
indexdef:=generrordef;
isgeneric:=false;
{ use defaults which don't overflow the compiler }
lowval:=0;
highval:=0;
@ -1424,12 +1427,15 @@ implementation
else
begin
pt:=expr(true);
isgeneric:=false;
if pt.nodetype=typen then
setdefdecl(pt.resultdef)
else
begin
if pt.nodetype=rangen then
begin
if nf_generic_para in pt.flags then
isgeneric:=true;
{ pure ordconstn expressions can be checked for
generics as well, but don't give an error in case
of parsing a generic if that isn't yet the case }
@ -1446,7 +1452,9 @@ implementation
highval:=tordconstnode(trangenode(pt).right).value;
if highval<lowval then
begin
Message(parser_e_array_lower_less_than_upper_bound);
{ ignore error if node is generic param }
if not (nf_generic_para in pt.flags) then
Message(parser_e_array_lower_less_than_upper_bound);
highval:=lowval;
end
else if (lowval<int64(low(asizeint))) or
@ -1494,6 +1502,8 @@ implementation
end;
if is_packed then
include(arrdef.arrayoptions,ado_IsBitPacked);
if isgeneric then
include(arrdef.arrayoptions,ado_IsGeneric);
if token=_COMMA then
consume(_COMMA)

11
compiler/symconst.pas
View File

@ -212,8 +212,9 @@ type
generic is encountered to ease inline
specializations, etc; those symbols can be
"overridden" with a completely different symbol }
sp_explicitrename { this is used to keep track of type renames created
sp_explicitrename, { this is used to keep track of type renames created
by the user }
sp_generic_const
);
tsymoptions=set of tsymoption;
@ -241,7 +242,10 @@ type
{ internal def that's not for any export }
df_internal,
{ the local def is referenced from a public function }
df_has_global_ref
df_has_global_ref,
{ the def was derived with generic type or const fields so the size
of the def can not be determined }
df_has_generic_fields
);
tdefoptions=set of tdefoption;
@ -567,7 +571,8 @@ type
ado_IsArrayOfConst, // array of const
ado_IsConstString, // string constant
ado_IsBitPacked, // bitpacked array
ado_IsVector // Vector
ado_IsVector, // Vector
ado_IsGeneric // the index of the array is generic (meaning that the size is not yet known)
);
tarraydefoptions=set of tarraydefoption;

54
compiler/symdef.pas
View File

@ -175,6 +175,9 @@ interface
function is_generic:boolean;
{ same as above for specializations }
function is_specialization:boolean;
{ generic utilities }
function is_generic_param_const(index:integer):boolean;inline;
function get_generic_param_def(index:integer):tdef;inline;
{ registers this def in the unit's deflist; no-op if already registered }
procedure register_def; override;
{ add the def to the top of the symtable stack if it's not yet owned
@ -2407,14 +2410,32 @@ implementation
for i:=0 to genericparas.count-1 do
begin
sym:=tsym(genericparas[i]);
if sym.typ<>symconst.typesym then
{ sym must be either a type or const }
if not (sym.typ in [symconst.typesym,symconst.constsym]) then
internalerror(2014050903);
if sym.owner.defowner<>self then
exit(false);
if (sym.typ=symconst.constsym) and (sp_generic_const in sym.symoptions) then
exit(false);
end;
end;
function tstoreddef.is_generic_param_const(index:integer):boolean;
begin
result:=tsym(genericparas[index]).typ=constsym;
end;
function tstoreddef.get_generic_param_def(index:integer):tdef;
begin
if tsym(genericparas[index]).typ=constsym then
result:=tconstsym(genericparas[index]).constdef
else
result:=ttypesym(genericparas[index]).typedef;
end;
function tstoreddef.is_specialization: boolean;
var
i : longint;
@ -2430,10 +2451,13 @@ implementation
for i:=0 to genericparas.count-1 do
begin
sym:=tsym(genericparas[i]);
if sym.typ<>symconst.typesym then
{ sym must be either a type or const }
if not (sym.typ in [symconst.typesym,symconst.constsym]) then
internalerror(2014050904);
if sym.owner.defowner<>self then
exit(true);
if (sym.typ=symconst.constsym) and (sp_generic_const in sym.symoptions) then
exit(true);
end;
result:=false;
end;
@ -4179,7 +4203,7 @@ implementation
ppufile.getderef(rangedefderef);
lowrange:=ppufile.getasizeint;
highrange:=ppufile.getasizeint;
ppufile.getset(tppuset1(arrayoptions));
ppufile.getset(tppuset2(arrayoptions));
ppuload_platform(ppufile);
symtable:=tarraysymtable.create(self);
tarraysymtable(symtable).ppuload(ppufile)
@ -4219,7 +4243,7 @@ implementation
ppufile.putderef(rangedefderef);
ppufile.putasizeint(lowrange);
ppufile.putasizeint(highrange);
ppufile.putset(tppuset1(arrayoptions));
ppufile.putset(tppuset2(arrayoptions));
writeentry(ppufile,ibarraydef);
tarraysymtable(symtable).ppuwrite(ppufile);
end;
@ -4339,6 +4363,7 @@ implementation
(ado_IsDynamicArray in arrayoptions) or
(ado_IsConvertedPointer in arrayoptions) or
(ado_IsConstructor in arrayoptions) or
(ado_IsGeneric in arrayoptions) or
(highrange<lowrange)
) and
(size=-1) then
@ -4543,7 +4568,8 @@ implementation
fullparas,
paramname : ansistring;
module : tmodule;
sym : ttypesym;
sym : tsym;
def : tdef;
i : longint;
begin
{ we want at least enough space for an ellipsis }
@ -4552,15 +4578,21 @@ implementation
fullparas:='';
for i:=0 to genericparas.count-1 do
begin
sym:=ttypesym(genericparas[i]);
sym:=tsym(genericparas[i]);
module:=find_module_from_symtable(sym.owner);
if not assigned(module) then
internalerror(2014121202);
paramname:=module.realmodulename^;
if sym.typedef.typ in [objectdef,recorddef] then
paramname:=paramname+'.'+tabstractrecorddef(sym.typedef).rttiname
if not (sym.typ in [constsym,symconst.typesym]) then
internalerror(2020042501);
if sym.typ=constsym then
def:=tconstsym(sym).constdef
else
paramname:=paramname+'.'+sym.typedef.typename;
def:=ttypesym(sym).typedef;
paramname:=module.realmodulename^;
if def.typ in [objectdef,recorddef] then
paramname:=paramname+'.'+tabstractrecorddef(def).rttiname
else
paramname:=paramname+'.'+def.typename;
if length(fullparas)+commacount[i>0]+length(paramname)>maxlength then
begin
if i>0 then
@ -5958,7 +5990,7 @@ implementation
if AValue then
include(implprocoptions,pio_empty)
else
include(implprocoptions,pio_empty);
exclude(implprocoptions,pio_empty);
end;

40
compiler/symsym.pas
View File

@ -401,6 +401,7 @@ interface
constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);virtual;
constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);virtual;
constructor create_undefined(const n : string;def:tdef);virtual;
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
procedure buildderef;override;
@ -491,6 +492,8 @@ interface
procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);inline;
procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring;filepos:tfileposinfo);
function same_constvalue(consttyp:tconsttyp;const value1,value2:tconstvalue):boolean;
implementation
uses
@ -528,6 +531,30 @@ implementation
end;
function same_constvalue(consttyp:tconsttyp;const value1,value2:tconstvalue):boolean;
begin
case consttyp of
constnone,
constnil:
result:=true;
constord:
result:=value1.valueord=value2.valueord;
constpointer:
result:=value1.valueordptr=value2.valueordptr;
conststring,
constreal,
constset,
constresourcestring,
constwstring,
constguid: begin
if value1.len<>value2.len then
exit(false);
result:=CompareByte(value1.valueptr^,value2.valueptr^,value1.len)=0;
end;
end;
end;
procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
begin
check_hints(srsym,symoptions,deprecatedmsg,current_filepos);
@ -1618,7 +1645,6 @@ implementation
tparasymtable(parast).ppuwrite(ppufile);
end;
{****************************************************************************
TABSTRACTVARSYM
****************************************************************************}
@ -2426,6 +2452,15 @@ implementation
end;
constructor tconstsym.create_undefined(const n : string;def: tdef);
begin
inherited create(constsym,n);
fillchar(value,sizeof(value),#0);
consttyp:=constnone;
constdef:=def;
end;
constructor tconstsym.ppuload(ppufile:tcompilerppufile);
var
pd : pbestreal;
@ -2509,8 +2544,7 @@ implementation
destructor tconstsym.destroy;
begin
case consttyp of
constnone:
internalerror(2019050703);
constnone,
constord,
constpointer,
constnil:

7
compiler/systems.pas
View File

@ -1147,7 +1147,14 @@ begin
{$endif riscv64}
{$ifdef xtensa}
{$ifdef linux}
{$define default_target_set}
default_target(system_xtensa_linux);
{$endif}
{$ifndef default_target_set}
default_target(system_xtensa_embedded);
{$endif ndef default_target_set}
{$endif xtensa}
end;

11
compiler/utils/ppuutils/ppudump.pp
View File

@ -1687,7 +1687,8 @@ const
(mask:sp_generic_para; str:'Generic Parameter'),
(mask:sp_has_deprecated_msg; str:'Has Deprecated Message'),
(mask:sp_generic_dummy; str:'Generic Dummy'),
(mask:sp_explicitrename; str:'Explicit Rename')
(mask:sp_explicitrename; str:'Explicit Rename'),
(mask:sp_generic_const; str:'Generic Constant Parameter')
);
var
symoptions : tsymoptions;
@ -2743,7 +2744,8 @@ const
(mask:df_not_registered_no_free; str:'Unregistered/No free (invalid)'),
(mask:df_llvm_no_struct_packing; str:'LLVM unpacked struct'),
(mask:df_internal; str:'Internal'),
(mask:df_has_global_ref; str:'Has Global Ref')
(mask:df_has_global_ref; str:'Has Global Ref'),
(mask:df_has_generic_fields; str:'Has generic fields')
);
defstate : array[1..ord(high(tdefstate))] of tdefstateinfo=(
(mask:ds_vmt_written; str:'VMT Written'),
@ -3267,14 +3269,15 @@ const
{ ado_IsArrayOfConst } 'ArrayOfConst',
{ ado_IsConstString } 'ConstString',
{ ado_IsBitPacked } 'BitPacked',
{ ado_IsVector } 'Vector'
{ ado_IsVector } 'Vector',
{ ado_IsGeneric } 'Generic'
);
var
symoptions: tarraydefoptions;
i: tarraydefoption;
first: boolean;
begin
ppufile.getset(tppuset1(symoptions));
ppufile.getset(tppuset2(symoptions));
if symoptions<>[] then
begin
if ado_IsDynamicArray in symoptions then Include(ArrayDef.Options, aoDynamic);

3
compiler/version.pas
View File

@ -80,6 +80,9 @@ interface
{$ifdef cpuriscv32}
source_cpu_string = 'riscv32';
{$endif cpuriscv32}
{$ifdef cpuxtensa}
source_cpu_string = 'xtensa';
{$endif cpuxtensa}
function version_string:string;
function full_version_string:string;

2
compiler/xtensa/agcpugas.pas
View File

@ -173,7 +173,7 @@ unit agcpugas;
idtxt : 'AS';
asmbin : 'as';
asmcmd : '-o $OBJ $EXTRAOPT $ASM --longcalls';
supported_targets : [system_xtensa_embedded];
supported_targets : [system_xtensa_embedded,system_xtensa_linux,system_xtensa_freertos];
flags : [af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses];
labelprefix : '.L';
labelmaxlen : -1;

9
packages/fcl-passrc/src/pasresolver.pp
View File

@ -431,7 +431,8 @@ const
btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
btAllRanges = btArrayRangeTypes+[btRange];
btAllWithSubType = [btSet, btArrayLit, btArrayOrSet, btRange];
btAllStandardTypes = [
btAllIntrinsicTypes = btAllInteger+btAllStringAndChars+btAllFloats+btAllBooleans;
btAllFPCTypes = [
btChar,
{$ifdef FPC_HAS_CPSTRING}
btAnsiChar,
@ -2080,7 +2081,7 @@ type
// built in types and functions
procedure ClearBuiltInIdentifiers; virtual;
procedure AddObjFPCBuiltInIdentifiers(
const TheBaseTypes: TResolveBaseTypes = btAllStandardTypes;
const TheBaseTypes: TResolveBaseTypes = btAllFPCTypes;
const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
@ -10435,7 +10436,7 @@ begin
end;
end;
// default: search for type helpers
if (LeftResolved.BaseType in btAllStandardTypes)
if (LeftResolved.BaseType in btAllIntrinsicTypes)
or (LeftResolved.BaseType=btContext)
or (LeftResolved.BaseType=btCustom) then
begin
@ -22038,7 +22039,7 @@ begin
if LoType=nil then
RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
[BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
if (ExprResolved.BaseType in btAllStandardTypes) then
if (ExprResolved.BaseType in btAllIntrinsicTypes) then
// ok
else if (ExprResolved.BaseType=btContext) then
// ok

4
packages/libffi/src/ffi.pp
View File

@ -272,8 +272,8 @@ const
FFI_TRAMPOLINE_SIZE = 20;
{$elseif defined(CPUMIPS64)}
FFI_TRAMPOLINE_SIZE = 56;
#endif
{$elseif defined(CPUXTENSA)}
FFI_TRAMPOLINE_SIZE = 24;
{$endif}
{

2
packages/os4units/src/clipboard.pas
View File

@ -13,7 +13,7 @@
**********************************************************************}
unit clipboard;
{$PACKRECORDS 2}
interface
uses

43
packages/pastojs/src/fppas2js.pp
View File

@ -15106,42 +15106,39 @@ begin
ClassPath:=CreateReferencePath(ProcScope.ClassRecScope.Element,AContext,rpkPathAndName);
Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
end;
if (ImplProc.Body.Functions.Count>0)
or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
begin
// has nested procs -> add "var self = this;"
FuncContext.AddLocalVar(GetBIName(pbivnSelf),ThisPas);
SelfSt:=CreateVarStatement(GetBIName(pbivnSelf),
CreatePrimitiveDotExpr('this',ImplProc),ImplProc);
AddBodyStatement(SelfSt,PosEl);
if ImplProcScope.SelfArg<>nil then
begin
// redirect Pascal-Self to JS-Self
FuncContext.AddLocalVar(GetBIName(pbivnSelf),ImplProcScope.SelfArg);
end;
end
else if ImplProcScope.SelfArg<>nil then
begin
// no nested procs -> redirect Pascal-Self to JS-this
FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
end;
end
else
begin
// no "this"
// "this" has no direct Pascal element
if ProcScope.ClassRecScope<>nil then
begin
// static method -> hide local
// static method
ClassOrRec:=ProcScope.ClassRecScope.Element;
LocalVar:=FuncContext.FindLocalIdentifier(ClassOrRec);
if (LocalVar<>nil) and (LocalVar.Name='this') then
// "this" is not the class -> hide it (absolute path will be used)
FuncContext.AddLocalVar(LocalVarHide,ClassOrRec);
end;
end;
if (ImplProc.Body.Functions.Count>0)
or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
begin
// has nested procs -> add "var $Self = this;"
if ThisPas<>nil then
FuncContext.AddLocalVar(GetBIName(pbivnSelf),ThisPas);
SelfSt:=CreateVarStatement(GetBIName(pbivnSelf),
CreatePrimitiveDotExpr('this',ImplProc),ImplProc);
AddBodyStatement(SelfSt,PosEl);
if ImplProcScope.SelfArg<>nil then
begin
// no nested procs -> redirect Pascal-Self to JS-this
FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
// redirect Pascal-Self to JS-Self
FuncContext.AddLocalVar(GetBIName(pbivnSelf),ImplProcScope.SelfArg);
end;
end
else if ImplProcScope.SelfArg<>nil then
begin
// no nested procs -> redirect Pascal-Self to JS-this
FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
end;
end;
{$IFDEF VerbosePas2JS}

133
packages/pastojs/tests/tcmodules.pas
View File

@ -702,12 +702,14 @@ type
Procedure TestTypeHelper_Constructor;
Procedure TestTypeHelper_Word;
Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_NativeInt;
Procedure TestTypeHelper_StringChar;
Procedure TestTypeHelper_JSValue;
Procedure TestTypeHelper_Array;
Procedure TestTypeHelper_EnumType;
Procedure TestTypeHelper_SetType;
Procedure TestTypeHelper_InterfaceType;
Procedure TestTypeHelper_NestedSelf;
// proc types
Procedure TestProcType;
@ -24090,6 +24092,99 @@ begin
'']));
end;
procedure TTestModule.TestTypeHelper_NativeInt;
begin
StartProgram(false);
Add([
'{$modeswitch typehelpers}',
'type',
' MaxInt = type nativeint;',
' THelperI = type helper for MaxInt',
' function ToStr: String;',
' end;',
' MaxUInt = type nativeuint;',
' THelperU = type helper for MaxUInt',
' function ToStr: String;',
' end;',
'function THelperI.ToStr: String;',
'begin',
' Result:=str(Self);',
'end;',
'function THelperU.ToStr: String;',
'begin',
' Result:=str(Self);',
'end;',
'procedure DoIt(s: string);',
'begin',
'end;',
'var i: MaxInt;',
'begin',
' DoIt(i.toStr);',
' DoIt(i.toStr());',
' (i*i).toStr;',
' DoIt((i*i).toStr);',
'']);
ConvertProgram;
CheckSource('TestTypeHelper_NativeInt',
LinesToStr([ // statements
'rtl.createHelper($mod, "THelperI", null, function () {',
' this.ToStr = function () {',
' var Result = "";',
' Result = "" + this.get();',
' return Result;',
' };',
'});',
'rtl.createHelper($mod, "THelperU", null, function () {',
' this.ToStr = function () {',
' var Result = "";',
' Result = "" + this.get();',
' return Result;',
' };',
'});',
'this.DoIt = function (s) {',
'};',
'this.i = 0;',
'']),
LinesToStr([ // $mod.$main
'$mod.DoIt($mod.THelperI.ToStr.call({',
' p: $mod,',
' get: function () {',
' return this.p.i;',
' },',
' set: function (v) {',
' this.p.i = v;',
' }',
'}));',
'$mod.DoIt($mod.THelperI.ToStr.call({',
' p: $mod,',
' get: function () {',
' return this.p.i;',
' },',
' set: function (v) {',
' this.p.i = v;',
' }',
'}));',
'$mod.THelperI.ToStr.call({',
' a: $mod.i * $mod.i,',
' get: function () {',
' return this.a;',
' },',
' set: function (v) {',
' rtl.raiseE("EPropReadOnly");',
' }',
'});',
'$mod.DoIt($mod.THelperI.ToStr.call({',
' a: $mod.i * $mod.i,',
' get: function () {',
' return this.a;',
' },',
' set: function (v) {',
' rtl.raiseE("EPropReadOnly");',
' }',
'}));',
'']));
end;
procedure TTestModule.TestTypeHelper_StringChar;
begin
StartProgram(false);
@ -24597,6 +24692,44 @@ begin
'']));
end;
procedure TTestModule.TestTypeHelper_NestedSelf;
begin
StartProgram(false);
Add([
'{$modeswitch typehelpers}',
'type',
' THelper = type helper for string',
' procedure Run(Value: string);',
' end;',
'procedure THelper.Run(Value: string);',
' function Sub(i: nativeint): boolean;',
' begin',
' Result:=Self[i+1]=Value[i];',
' end;',
'begin',
' if Self[3]=Value[4] then ;',
'end;',
'begin',
'']);
ConvertProgram;
CheckSource('TestTypeHelper_NestedSelf',
LinesToStr([ // statements
'rtl.createHelper($mod, "THelper", null, function () {',
' this.Run = function (Value) {',
' var $Self = this;',
' function Sub(i) {',
' var Result = false;',
' Result = $Self.get().charAt((i + 1) - 1) === Value.charAt(i - 1);',
' return Result;',
' };',
' if ($Self.get().charAt(2) === Value.charAt(3)) ;',
' };',
'});',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestModule.TestProcType;
begin
StartProgram(false);

12
packages/rtl-console/src/amicommon/video.pp
View File

@ -584,11 +584,11 @@ begin
SmallForce or ForceCursorUpdate then
begin
{$ifdef WITHBUFFERING}
DrawChar(BufRp, OldCursorY, OldCursorX, crHidden);
if CursorState then DrawChar(BufRp, CursorY, CursorX, CursorType);
DrawChar(BufRp, OldCursorX, OldCursorY, crHidden);
if CursorState then DrawChar(BufRp, CursorX, CursorY, CursorType);
{$else}
DrawChar(VideoWindow^.RPort, OldCursorY, OldCursorX, crHidden);
if CursorState then DrawChar(VideoWindow^.RPort, CursorY, CursorX, CursorType);
DrawChar(VideoWindow^.RPort, OldCursorX, OldCursorY, crHidden);
if CursorState then DrawChar(VideoWindow^.RPort, CursorX, CursorY, CursorType);
{$endif}
OldCursorX := CursorX;
OldCursorY := CursorY;
@ -602,8 +602,8 @@ end;
procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
begin
CursorX := NewCursorY;
CursorY := NewCursorX;
CursorX := NewCursorX;
CursorY := NewCursorY;
SysUpdateScreen(False);
end;

2
packages/rtl-extra/src/linux/unixsock.inc
View File

@ -13,7 +13,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$if not defined(cpux86_64) and not defined(cpuaarch64) and not defined(cpuriscv32) and not defined(cpuriscv64) and not defined(NO_SYSCALL_SOCKETCALL)}
{$if not defined(cpux86_64) and not defined(cpuaarch64) and not defined(cpuriscv32) and not defined(cpuriscv64) and not defined(cpuxtensa) and not defined(NO_SYSCALL_SOCKETCALL)}
{$define NEED_SOCKETCALL}
{$endif}

4
packages/rtl-extra/src/unix/ipc.pp
View File

@ -546,7 +546,7 @@ type
msg_lrpid : ipc_pid_t;
pad1 : qword;
pad2 : qword;
{$ENDIF}
{$ENDIF}
end;
{$else}
{$if defined(Darwin)}
@ -888,7 +888,7 @@ uses Syscall;
{$ifndef FPC_USE_LIBC}
{$if defined(Linux)}
{$if defined(cpux86_64) or defined(cpuaarch64) or defined(cpuriscv32) or defined(cpuriscv64) or defined(NO_SYSCALL_IPC)}
{$if defined(cpux86_64) or defined(cpuaarch64) or defined(cpuriscv32) or defined(cpuriscv64) or defined(cpuxtensa) or defined(NO_SYSCALL_IPC)}
{$i ipcsys.inc}
{$else}
{$i ipccall.inc}

5
rtl/xtensa/setjump.inc
View File

@ -14,13 +14,12 @@
**********************************************************************}
function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe; compilerproc;
function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc;
asm
movi a2,0
end;
procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; compilerproc;
asm
end;

39
tests/test/tgenconst1.pp Normal file
View File

@ -0,0 +1,39 @@
{ %NORUN }
{$mode objfpc}
{
test all possible constants
}
program tgenconst1;
type
TEnums = (Blaise, Pascal);
kNames = set of TEnums;
kChars = set of char;
type
generic TBoolean<const U: boolean> = record end;
generic TString<const U: string> = record end;
generic TFloat<const U: single> = record end;
generic TInteger<const U: integer> = record end;
generic TChar<const U: char> = record end;
generic TByte<const U: byte> = record end;
generic TQWord<const U: QWord> = record end;
generic TEnum<const U: TEnums> = record end;
generic TNames<const U: kNames> = record end;
generic TChars<const U: kChars> = record end;
generic TPointer<const U: pointer> = record end;
var
a: specialize TBoolean<true>;
b: specialize TString<'string'>;
c: specialize TFloat<1>;
d: specialize TInteger<10>;
e: specialize TByte<255>;
f: specialize TChar<'a'>;
g: specialize TEnum<Pascal>;
h: specialize TNames<[Blaise,Pascal]>;
i: specialize TChars<['a','b']>;
j: specialize TQWord<10>;
k: specialize TPointer<nil>;
begin
end.

14
tests/test/tgenconst10.pp Normal file
View File

@ -0,0 +1,14 @@
{%FAIL}
{$mode objfpc}
{
test type mismatch when specializing generic type with constant value
}
program tgenconst10;
type
generic TByte<T> = record end;
var
a: specialize TByte<10>;
begin
end.

13
tests/test/tgenconst11.pp Normal file
View File

@ -0,0 +1,13 @@
{%FAIL}
{$mode objfpc}
{
test def compare fail with specialized types
}
program tgenconst11;
type
generic TConst<const U: integer> = class end;
var
a:specialize TConst<10>;
begin
a:=specialize TConst<'string'>.Create;
end

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

@ -0,0 +1,15 @@
{ %NORUN }
{$mode objfpc}
{
test def compare with specialized types
}
program tgenconst12;
type
generic TTest<const U: integer> = class
end;
type
ATest = specialize TTest<100>;
begin
end.

51
tests/test/tgenconst13.pp Normal file
View File

@ -0,0 +1,51 @@
{$mode objfpc}
{$modeswitch advancedrecords}
{
test advanced record constants assigned from generic constant values
}
program tgenconst13;
type
kNames = set of (Blaise,Pascal);
kChars = set of char;
type
generic TBoolean<const U: boolean> = record const value = U; end;
generic TString<const U: string> = record const value = U; end;
generic TFloat<const U: single> = record const value = U; end;
generic TInteger<const U: integer> = record const value = U; end;
generic TByte<const U: byte> = record const value = U; end;
generic TChar<const U: char> = record const value = U; end;
generic TQWord<const U: QWord> = record const value = U; end;
generic TNames<const U: kNames> = record const value = U; end;
generic TChars<const U: kChars> = record const value = U; end;
procedure Test(failed: boolean); inline;
begin
if failed then
begin
writeln('failed!');
halt(-1);
end;
end;
var
g0: specialize TBoolean<true>;
g1: specialize TString<'string'>;
g2: specialize TFloat<10.5>;
g3: specialize TInteger<10>;
g4: specialize TByte<255>;
g5: specialize TChar<'a'>;
g6: specialize TQWord<1000000000>;
g7: specialize TNames<[Blaise,Pascal]>;
g8: specialize TChars<['a','b']>;
begin
Test(g0.value <> true);
Test(g1.value <> 'string');
Test(g2.value <> 10.5);
Test(g3.value <> 10);
Test(g4.value <> 255);
Test(g5.value <> 'a');
Test(g6.value <> 1000000000);
Test(g7.value <> [Blaise,Pascal]);
Test(g8.value <> ['a','b']);
end.

42
tests/test/tgenconst14.pp Normal file
View File

@ -0,0 +1,42 @@
{$mode objfpc}
{$modeswitch advancedrecords}
{
test binary operators with generic constant params
}
program tgenconst14;
type
generic TBinaryOp<const I: Integer> = record
const
d0 = I + I;
d1 = I - I;
d2 = I * I;
d3 = I / I;
d4 = I div I;
d5 = I mod I;
d6 = I and I;
d7 = I or I;
d8 = I shl 2;
d9 = I shr 2;
end;
procedure Check(aExpected, aActual: Integer; aErrorCode: LongInt);
begin
if aExpected <> aActual then
Halt(aErrorCode);
end;
var
op: specialize TBinaryOp<100>;
begin
Check(op.d0, 100 + 100, 1);
Check(op.d1, 100 - 100, 2);
Check(op.d2, 100 * 100, 3);
Check(Trunc(op.d3), Trunc(100 / 100), 4);
Check(op.d4, 100 div 100, 5);
Check(op.d5, 100 mod 100, 6);
Check(op.d6, 100 and 100, 7);
Check(op.d7, 100 or 100, 8);
Check(op.d8, 100 shl 2, 9);
Check(op.d9, 100 shr 2, 10);
end.

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

@ -0,0 +1,15 @@
{%FAIL}
{$mode objfpc}
{$modeswitch advancedrecords}
{
test binary operator error with wrong constant type
}
program tgenconst15;
type
generic TInt<const I: string> = record
const c = I div I;
end;
begin
end.

79
tests/test/tgenconst16.pp Normal file
View File

@ -0,0 +1,79 @@
{ %NORUN }
{$mode objfpc}
{$modeswitch advancedrecords}
{
various operator tests
}
program tgenconst16;
type
Day = (mon,tue,wed,thu,fri,sat,sun);
Days = set of Day;
generic TSet<const I: Days> = record
const
d0 = I + I; // Union
d1 = I - I; // Difference
d2 = I * I; // Intersection
d3 = I >< I; // Symmetric difference
d4 = I <= I; // Contains
d5 = mon in I;
end;
generic TArray<const I: integer> = record
type
t0 = array[0..I - 1] of integer;
t1 = array[0..high(I)] of integer;
t2 = array[0..low(I)] of integer;
t3 = array[0..sizeof(I)] of integer;
public
d0: array[0..I - 1] of integer;
d1: array[0..high(I)] of integer;
d2: array[0..low(I)] of integer;
d3: array[0..sizeof(I)] of integer;
end;
generic TUnaryOp<const I: integer> = record
const
d0 = -I;
d1 = +I;
d2 = not I;
end;
generic TBinaryOp<const I: integer> = record
const
// Arithmetic operators
// https://freepascal.org/docs-html/ref/refsu45.html
d0 = I + I;
d1 = I - I;
d2 = I * I;
d3 = I / I;
d4 = I div I;
d5 = I mod I;
// Boolean operators
// https://freepascal.org/docs-html/ref/refsu47.html
d6 = I and I;
d7 = I or I;
d8 = I xor I;
// Logical operators
// https://freepascal.org/docs-html/ref/refsu46.html
d9 = I shl I;
d10 = I shr I;
d11 = I << I;
d12 = I >> I;
// Relational operators
// https://freepascal.org/docs-html/ref/refsu50.html#x153-17500012.8.6
d13 = I <> I;
d14 = I < I;
d15 = I > I;
d16 = I <= I;
d17 = I >= I;
d18 = I = I;
end;
generic TOther<const I: integer> = record
procedure DoThis(param: integer = I);
end;
procedure TOther.DoThis(param: integer = I);
begin
writeln(param, ' default:', I);
end;
begin
end.

27
tests/test/tgenconst17.pp Normal file
View File

@ -0,0 +1,27 @@
{ %NORUN }
{$mode objfpc}
{$modeswitch advancedrecords}
{
testing range checking for arrays and for-loops
}
program tgenconst17;
type
generic TStaticList<T; const Length: SizeUInt> = record
Values: array[0..Length - 1] of T;
procedure Display;
end;
procedure TStaticList.Display;
var
I, n: SizeUInt;
begin
for I := 0 to Length - 1 do
WriteLn(Values[I]);
end;
var
list: specialize TStaticList<Integer, 20>;
begin
end.

12
tests/test/tgenconst18.pp Normal file
View File

@ -0,0 +1,12 @@
{%FAIL}
{$mode objfpc}
{
test undefined constants which must be typed
}
program tgenconst18;
type
generic TUndefined<const U> = record end;
begin
end.

24
tests/test/tgenconst19.pp Normal file
View File

@ -0,0 +1,24 @@
{ %NORUN }
unit tgenconst19;
{$mode objfpc}
interface
generic procedure Test<const A, B: LongInt>;
generic procedure Test2<const A, B: LongInt>;
implementation
{ currently it does not matter whether , or ; is used in the definition (Delphi
compatible) }
generic procedure Test<A, B>;
begin
end;
generic procedure Test2<A; B>;
begin
end;
end.

14
tests/test/tgenconst2.pp Normal file
View File

@ -0,0 +1,14 @@
{ %NORUN }
{$mode objfpc}
{
test lists of types/contants
}
program tgenconst2;
type
generic TMoreThanOne<T1,T2;const U1,U2:integer> = record end;
var
a: specialize TMoreThanOne<integer,string,10,10>;
begin
end.

24
tests/test/tgenconst20.pp Normal file
View File

@ -0,0 +1,24 @@
{ %NORUN }
unit tgenconst20;
{$mode delphi}
interface
procedure Test<const A, B: LongInt>;
procedure Test2<const A, B: LongInt>;
implementation
{ currently it does not matter whether , or ; is used in the definition (Delphi
compatible) }
procedure Test<A, B>;
begin
end;
procedure Test2<A; B>;
begin
end;
end.

16
tests/test/tgenconst21.pp Normal file
View File

@ -0,0 +1,16 @@
unit tgenconst21;
{$mode objfpc}
interface
implementation
generic procedure Test<A; const N: LongInt>; forward;
generic procedure Test<A; const N: LongInt>;
begin
end;
end.

16
tests/test/tgenconst22.pp Normal file
View File

@ -0,0 +1,16 @@
unit tgenconst22;
{$mode delphi}
interface
implementation
procedure Test<A; const N: LongInt>; forward;
procedure Test<A; const N: LongInt>;
begin
end;
end.

19
tests/test/tgenconst23.pp Normal file
View File

@ -0,0 +1,19 @@
{ %FAIL }
unit tgenconst23;
{$mode objfpc}
interface
implementation
generic procedure Test<A; const N: LongInt>; forward;
generic procedure Test<A; const N: String>;
begin
end;
end.

19
tests/test/tgenconst24.pp Normal file
View File

@ -0,0 +1,19 @@
{ %FAIL }
unit tgenconst24;
{$mode delphi}
interface
implementation
procedure Test<A; const N: LongInt>; forward;
procedure Test<A; const N: String>;
begin
end;
end.

18
tests/test/tgenconst25.pp Normal file
View File

@ -0,0 +1,18 @@
{ %FAIL }
unit tgenconst25;
{$mode objfpc}
interface
implementation
generic procedure Test<A; const N: LongInt>; forward;
generic procedure Test<A; N>;
begin
end;
end.

18
tests/test/tgenconst26.pp Normal file
View File

@ -0,0 +1,18 @@
{ %FAIL }
unit tgenconst26;
{$mode delphi}
interface
implementation
procedure Test<A; const N: LongInt>; forward;
procedure Test<A; N>;
begin
end;
end.

17
tests/test/tgenconst27.pp Normal file
View File

@ -0,0 +1,17 @@
{ %FAIL }
unit tgenconst27;
{$mode objfpc}
interface
generic procedure Test<const A: LongInt>;
implementation
generic procedure Test<const A: LongInt>;
begin
end;
end.

17
tests/test/tgenconst28.pp Normal file
View File

@ -0,0 +1,17 @@
{ %FAIL }
unit tgenconst28;
{$mode delphi}
interface
procedure Test<const A: LongInt>;
implementation
procedure Test<const A: LongInt>;
begin
end;
end.

14
tests/test/tgenconst29.pp Normal file
View File

@ -0,0 +1,14 @@
{ %NORUN }
program tgenconst29;
{$mode objfpc}
type
TRange = 3..4;
generic TTest<const U: TRange> = record end;
var
t: specialize TTest<3>;
begin
end.

20
tests/test/tgenconst3.pp Normal file
View File

@ -0,0 +1,20 @@
{ %NORUN }
{$mode objfpc}
{$modeswitch advancedrecords}
{
test integer constants in static array ranges
}
program tgenconst3;
type
generic TList<T;const U:integer> = record
const
max = U;
public
m_list: array[0..max-1] of T;
end;
var
list: specialize TList<integer,128>;
begin
end.

14
tests/test/tgenconst30.pp Normal file
View File

@ -0,0 +1,14 @@
{ %FAIL }
program tgenconst30;
{$mode objfpc}
type
TRange = 3..4;
generic TTest<const U: TRange> = record end;
var
t: specialize TTest<2>;
begin
end.

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

@ -0,0 +1,15 @@
{ %NORUN }
{$mode objfpc}
{
test constants in generic procedures
}
program tgenconst4;
generic procedure DoThis<T;const U:string>(msg: string = U);
begin
writeln(msg, ' sizeof:',sizeof(t), ' default: ', U);
end;
begin
specialize DoThis<integer,'genparam'>('hello world');
end.

28
tests/test/tgenconst5.pp Normal file
View File

@ -0,0 +1,28 @@
{ %NORUN }
{$mode objfpc}
{
test nested generic records with constants
}
program tgenconst5;
type
generic THelperA<const U:integer> = record
list: array[0..U-1] of byte;
end;
type
generic THelperB<T> = record
value: T;
end;
type
generic TList<T; const U:integer> = record
helperA: specialize THelperA<U>;
helperB: specialize THelperB<T>;
end;
var
list: specialize TList<integer,32>;
begin
writeln('sizeof:',sizeof(list));
end.

25
tests/test/tgenconst6.pp Normal file
View File

@ -0,0 +1,25 @@
{ %NORUN }
{$mode delphi}
{
test delphi mode
}
program tgenconst6;
type
TList<T; const U: integer> = class
list: array[0..U-1] of T;
function capacity: integer;
end;
function TList<T; U>.capacity: integer;
begin
result := U;
end;
var
nums:TList<integer,16>;
strs:TList<string,16>;
begin
nums := TList<integer,16>.Create;
strs := TList<string,16>.Create;
end.

14
tests/test/tgenconst7.pp Normal file
View File

@ -0,0 +1,14 @@
{%FAIL}
{$mode objfpc}
{
test type mismatch when specializing constant values
}
program tgenconst7;
type
generic TInteger<const U: integer> = record end;
var
a: specialize TInteger<'string'>;
begin
end.

14
tests/test/tgenconst8.pp Normal file
View File

@ -0,0 +1,14 @@
{%FAIL}
{$mode objfpc}
{
test out of range error with constants
}
program tgenconst8;
type
generic TByte<const U: Byte> = record end;
var
a: specialize TByte<300>;
begin
end.

12
tests/test/tgenconst9.pp Normal file
View File

@ -0,0 +1,12 @@
{%FAIL}
{$mode objfpc}
{
test type mismatch when specializing constants with types
}
program tgenconst9;
type
generic TByte<const U: Byte> = record end;
var
a: specialize TByte<string>;
begin
end.

10
tests/webtbf/tw36975.pp Normal file
View File

@ -0,0 +1,10 @@
{ %FAIL }
program tw36975;
{$mode objfpc}{$H+}
type
generic TTest <T,const N:Tintegerarray> = class
end;
begin
end.