mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-10 14:09:15 +02:00
* allow assignment of overloaded procedures to procvars when we know
which procedure to take
This commit is contained in:
peter
parent
1137fb17c2
commit
ac400051bd
@ -352,7 +352,7 @@ implementation
|
||||
hregister,hp);
|
||||
|
||||
{ virtual method ? }
|
||||
if (po_virtualmethod in tprocsym(symtableentry).definition.procoptions) then
|
||||
if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
|
||||
begin
|
||||
new(hp);
|
||||
reset_reference(hp^);
|
||||
@ -367,8 +367,8 @@ implementation
|
||||
new(hp);
|
||||
reset_reference(hp^);
|
||||
hp^.base:=R_EDI;
|
||||
hp^.offset:=tprocsym(symtableentry).definition._class.vmtmethodoffset(
|
||||
tprocsym(symtableentry).definition.extnumber);
|
||||
hp^.offset:=tprocdef(resulttype.def)._class.vmtmethodoffset(
|
||||
tprocdef(resulttype.def).extnumber);
|
||||
emit_ref_reg(A_MOV,S_L,
|
||||
hp,R_EDI);
|
||||
{ ... and store it }
|
||||
@ -379,7 +379,7 @@ implementation
|
||||
else
|
||||
begin
|
||||
ungetregister32(R_EDI);
|
||||
s:=newasmsymbol(tprocsym(symtableentry).definition.mangledname);
|
||||
s:=newasmsymbol(tprocdef(resulttype.def).mangledname);
|
||||
emit_sym_ofs_ref(A_MOV,S_L,s,0,
|
||||
newreference(location.reference));
|
||||
end;
|
||||
@ -387,7 +387,7 @@ implementation
|
||||
else
|
||||
begin
|
||||
{!!!!! Be aware, work on virtual methods too }
|
||||
location.reference.symbol:=newasmsymbol(tprocsym(symtableentry).definition.mangledname);
|
||||
location.reference.symbol:=newasmsymbol(tprocdef(resulttype.def).mangledname);
|
||||
end;
|
||||
end;
|
||||
typedconstsym :
|
||||
@ -1085,7 +1085,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 2001-10-14 11:49:51 jonas
|
||||
Revision 1.25 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.24 2001/10/14 11:49:51 jonas
|
||||
* finetuned register allocation info for assignments
|
||||
|
||||
Revision 1.23 2001/10/04 14:33:28 jonas
|
||||
|
||||
@ -726,7 +726,7 @@ implementation
|
||||
(
|
||||
(m_tp_procvar in aktmodeswitches) and
|
||||
(def.deftype=procvardef) and (p.left.nodetype=calln) and
|
||||
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def)))
|
||||
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def),false))
|
||||
)
|
||||
;
|
||||
end;
|
||||
@ -1743,8 +1743,9 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.52 2001-10-25 21:22:33 peter
|
||||
* calling convention rewrite
|
||||
Revision 1.53 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.51 2001/10/13 09:01:14 jonas
|
||||
* fixed bug with using procedures as procvar parameters in TP/Delphi mode
|
||||
|
||||
@ -766,6 +766,7 @@ implementation
|
||||
|
||||
var
|
||||
hp : tnode;
|
||||
currprocdef,
|
||||
aprocdef : tprocdef;
|
||||
|
||||
begin
|
||||
@ -837,8 +838,9 @@ implementation
|
||||
begin
|
||||
if is_procsym_call(left) then
|
||||
begin
|
||||
hp:=cloadnode.create(tprocsym(tcallnode(left).symtableprocentry),
|
||||
tcallnode(left).symtableproc);
|
||||
currprocdef:=get_proc_2_procvar_def(tprocsym(tcallnode(left).symtableprocentry),tprocvardef(resulttype.def));
|
||||
hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
|
||||
currprocdef,tcallnode(left).symtableproc);
|
||||
if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
|
||||
assigned(tcallnode(left).methodpointer) then
|
||||
tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
|
||||
@ -857,7 +859,7 @@ implementation
|
||||
the procvar, is compatible with the procvar's type }
|
||||
if assigned(aprocdef) then
|
||||
begin
|
||||
if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def)) then
|
||||
if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def),false) then
|
||||
CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename);
|
||||
end
|
||||
else
|
||||
@ -1595,7 +1597,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.41 2001-10-20 19:28:37 peter
|
||||
Revision 1.42 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.41 2001/10/20 19:28:37 peter
|
||||
* interface 2 guid support
|
||||
* guid constants support
|
||||
|
||||
|
||||
@ -28,13 +28,15 @@ interface
|
||||
|
||||
uses
|
||||
node,
|
||||
symbase,symtype,symsym;
|
||||
symbase,symtype,symsym,symdef;
|
||||
|
||||
type
|
||||
tloadnode = class(tunarynode)
|
||||
symtableentry : tsym;
|
||||
symtable : tsymtable;
|
||||
procsymdef : tprocdef;
|
||||
constructor create(v : tsym;st : tsymtable);virtual;
|
||||
constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
|
||||
procedure set_mp(p:tnode);
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
@ -106,7 +108,7 @@ implementation
|
||||
|
||||
uses
|
||||
cutils,verbose,globtype,globals,systems,
|
||||
symconst,symdef,symtable,types,
|
||||
symconst,symtable,types,
|
||||
htypechk,pass_1,
|
||||
ncnv,nmem,cpubase,tgcpu,cgbase
|
||||
;
|
||||
@ -117,15 +119,24 @@ implementation
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tloadnode.create(v : tsym;st : tsymtable);
|
||||
|
||||
begin
|
||||
inherited create(loadn,nil);
|
||||
if not assigned(v) then
|
||||
internalerror(200108121);
|
||||
symtableentry:=v;
|
||||
symtable:=st;
|
||||
procsymdef:=nil;
|
||||
end;
|
||||
|
||||
constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
|
||||
begin
|
||||
inherited create(loadn,nil);
|
||||
if not assigned(v) then
|
||||
internalerror(200108121);
|
||||
symtableentry:=v;
|
||||
symtable:=st;
|
||||
procsymdef:=d;
|
||||
end;
|
||||
|
||||
procedure tloadnode.set_mp(p:tnode);
|
||||
begin
|
||||
@ -228,9 +239,14 @@ implementation
|
||||
resulttype:=ttypedconstsym(symtableentry).typedconsttype;
|
||||
procsym :
|
||||
begin
|
||||
if assigned(tprocsym(symtableentry).definition.nextoverloaded) then
|
||||
CGMessage(parser_e_no_overloaded_procvars);
|
||||
resulttype.setdef(tprocsym(symtableentry).definition);
|
||||
if not assigned(procsymdef) then
|
||||
begin
|
||||
if assigned(tprocsym(symtableentry).definition.nextoverloaded) then
|
||||
CGMessage(parser_e_no_overloaded_procvars);
|
||||
resulttype.setdef(tprocsym(symtableentry).definition);
|
||||
end
|
||||
else
|
||||
resulttype.setdef(procsymdef);
|
||||
{ if the owner of the procsym is a object, }
|
||||
{ left must be set, if left isn't set }
|
||||
{ it can be only self }
|
||||
@ -801,7 +817,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2001-10-12 13:51:51 jonas
|
||||
Revision 1.27 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.26 2001/10/12 13:51:51 jonas
|
||||
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
|
||||
* fixed bug in n386add (introduced after compilerproc changes for string
|
||||
operations) where calcregisters wasn't called for shortstring addnodes
|
||||
|
||||
@ -68,6 +68,7 @@ interface
|
||||
tsimplenewdisposenodeclass = class of tsimplenewdisposenode;
|
||||
|
||||
taddrnode = class(tunarynode)
|
||||
getprocvardef : tprocvardef;
|
||||
constructor create(l : tnode);virtual;
|
||||
function pass_1 : tnode;override;
|
||||
function det_resulttype:tnode;override;
|
||||
@ -412,8 +413,10 @@ implementation
|
||||
the procedure that is stored in the procvar.}
|
||||
if not(m_tp_procvar in aktmodeswitches) then
|
||||
begin
|
||||
|
||||
hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition);
|
||||
if assigned(getprocvardef) then
|
||||
hp3:=getprocvardef
|
||||
else
|
||||
hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition);
|
||||
|
||||
{ create procvardef }
|
||||
resulttype.setdef(tprocvardef.create);
|
||||
@ -982,8 +985,9 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 2001-10-25 21:22:35 peter
|
||||
* calling convention rewrite
|
||||
Revision 1.22 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.20 2001/09/02 21:12:07 peter
|
||||
* move class of definitions into type section for delphi
|
||||
|
||||
@ -822,6 +822,7 @@ implementation
|
||||
hs,hs1 : tvarsym;
|
||||
para,p2 : tnode;
|
||||
hst : tsymtable;
|
||||
aprocdef : tprocdef;
|
||||
begin
|
||||
prevafterassn:=afterassignment;
|
||||
afterassignment:=false;
|
||||
@ -886,7 +887,11 @@ implementation
|
||||
|
||||
{ generate a methodcallnode or proccallnode }
|
||||
{ we shouldn't convert things like @tcollection.load }
|
||||
p2:=cloadnode.create(sym,st);
|
||||
if getprocvar then
|
||||
aprocdef:=get_proc_2_procvar_def(tprocsym(sym),getprocvardef)
|
||||
else
|
||||
aprocdef:=nil;
|
||||
p2:=cloadnode.create_procvar(sym,aprocdef,st);
|
||||
if assigned(p1) then
|
||||
tloadnode(p2).set_mp(p1);
|
||||
p1:=p2;
|
||||
@ -902,16 +907,15 @@ implementation
|
||||
procedure doconv(procvar : tprocvardef;var t : tnode);
|
||||
var
|
||||
hp : tnode;
|
||||
currprocdef : tprocdef;
|
||||
begin
|
||||
hp:=nil;
|
||||
if (proc_to_procvar_equal(tprocsym(tcallnode(t).symtableprocentry).definition,procvar)) then
|
||||
currprocdef:=get_proc_2_procvar_def(tcallnode(t).symtableprocentry,procvar);
|
||||
if assigned(currprocdef) then
|
||||
begin
|
||||
hp:=cloadnode.create(tprocsym(tcallnode(t).symtableprocentry),tcallnode(t).symtableproc);
|
||||
hp:=cloadnode.create_procvar(tprocsym(tcallnode(t).symtableprocentry),currprocdef,tcallnode(t).symtableproc);
|
||||
if (po_methodpointer in procvar.procoptions) then
|
||||
tloadnode(hp).set_mp(tnode(tcallnode(t).methodpointer).getcopy);
|
||||
end;
|
||||
if assigned(hp) then
|
||||
begin
|
||||
t.destroy;
|
||||
t:=hp;
|
||||
end;
|
||||
@ -1133,7 +1137,7 @@ implementation
|
||||
(getprocvar and
|
||||
((block_type=bt_const) or
|
||||
((m_tp_procvar in aktmodeswitches) and
|
||||
proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef)
|
||||
proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef,false)
|
||||
)
|
||||
)
|
||||
),again,p1);
|
||||
@ -1473,7 +1477,7 @@ implementation
|
||||
(getprocvar and
|
||||
((block_type=bt_const) or
|
||||
((m_tp_procvar in aktmodeswitches) and
|
||||
proc_to_procvar_equal(tprocsym(srsym).definition,getprocvardef)
|
||||
proc_to_procvar_equal(tprocsym(srsym).definition,getprocvardef,false)
|
||||
)
|
||||
)
|
||||
),again,p1);
|
||||
@ -1903,7 +1907,7 @@ implementation
|
||||
card : cardinal;
|
||||
ic : TConstExprInt;
|
||||
oldp1,
|
||||
p1,p2 : tnode;
|
||||
p1 : tnode;
|
||||
code : integer;
|
||||
{$ifdef TEST_PROCSYMS}
|
||||
unit_specific,
|
||||
@ -2177,6 +2181,8 @@ implementation
|
||||
p1:=factor(true);
|
||||
got_addrn:=false;
|
||||
p1:=caddrnode.create(p1);
|
||||
if getprocvar then
|
||||
taddrnode(p1).getprocvardef:=getprocvardef;
|
||||
end;
|
||||
|
||||
_LKLAMMER :
|
||||
@ -2416,8 +2422,7 @@ implementation
|
||||
_ASSIGNMENT :
|
||||
begin
|
||||
consume(_ASSIGNMENT);
|
||||
if (m_tp_procvar in aktmodeswitches) and
|
||||
(p1.resulttype.def.deftype=procvardef) then
|
||||
if (p1.resulttype.def.deftype=procvardef) then
|
||||
begin
|
||||
getprocvar:=true;
|
||||
getprocvardef:=tprocvardef(p1.resulttype.def);
|
||||
@ -2508,7 +2513,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.47 2001-10-24 11:51:39 marco
|
||||
Revision 1.48 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.47 2001/10/24 11:51:39 marco
|
||||
* Make new/dispose system functions instead of keywords
|
||||
|
||||
Revision 1.46 2001/10/21 13:10:51 peter
|
||||
|
||||
@ -221,7 +221,9 @@ interface
|
||||
function convertable_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
|
||||
|
||||
{ true if a function can be assigned to a procvar }
|
||||
function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef) : boolean;
|
||||
function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef;exact:boolean) : boolean;
|
||||
|
||||
function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef;
|
||||
|
||||
{ if l isn't in the range of def a range check error (if not explicit) is generated and
|
||||
the value is placed within the range }
|
||||
@ -411,7 +413,7 @@ implementation
|
||||
|
||||
|
||||
{ true if a function can be assigned to a procvar }
|
||||
function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef) : boolean;
|
||||
function proc_to_procvar_equal(def1:tprocdef;def2:tprocvardef;exact:boolean) : boolean;
|
||||
const
|
||||
po_comp = po_compatibility_options-[po_methodpointer,po_classmethod];
|
||||
var
|
||||
@ -438,7 +440,7 @@ implementation
|
||||
parameters may also be convertable }
|
||||
if is_equal(def1.rettype.def,def2.rettype.def) and
|
||||
(equal_paras(def1.para,def2.para,cp_all) or
|
||||
convertable_paras(def1.para,def2.para,cp_all)) and
|
||||
((not exact) and convertable_paras(def1.para,def2.para,cp_all))) and
|
||||
((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then
|
||||
proc_to_procvar_equal:=true
|
||||
else
|
||||
@ -446,6 +448,55 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef;
|
||||
var
|
||||
matchprocdef,
|
||||
currprocdef : tprocdef;
|
||||
begin
|
||||
{ This function will return the pprocdef of pprocsym that
|
||||
is the best match for procvardef. When there are multiple
|
||||
matches it returns nil }
|
||||
{ exact match }
|
||||
currprocdef:=p.definition;
|
||||
matchprocdef:=nil;
|
||||
while assigned(currprocdef) do
|
||||
begin
|
||||
if proc_to_procvar_equal(currprocdef,d,true) then
|
||||
begin
|
||||
{ already found a match ? Then stop and return nil }
|
||||
if assigned(matchprocdef) then
|
||||
begin
|
||||
matchprocdef:=nil;
|
||||
break;
|
||||
end;
|
||||
matchprocdef:=currprocdef;
|
||||
end;
|
||||
currprocdef:=currprocdef.nextoverloaded;
|
||||
end;
|
||||
{ convertable match, if no exact match was found }
|
||||
if not assigned(matchprocdef) and
|
||||
not assigned(currprocdef) then
|
||||
begin
|
||||
currprocdef:=p.definition;
|
||||
while assigned(currprocdef) do
|
||||
begin
|
||||
if proc_to_procvar_equal(currprocdef,d,false) then
|
||||
begin
|
||||
{ already found a match ? Then stop and return nil }
|
||||
if assigned(matchprocdef) then
|
||||
begin
|
||||
matchprocdef:=nil;
|
||||
break;
|
||||
end;
|
||||
matchprocdef:=currprocdef;
|
||||
end;
|
||||
currprocdef:=currprocdef.nextoverloaded;
|
||||
end;
|
||||
end;
|
||||
get_proc_2_procvar_def:=matchprocdef;
|
||||
end;
|
||||
|
||||
|
||||
{ returns true, if def uses FPU }
|
||||
function is_fpu(def : tdef) : boolean;
|
||||
begin
|
||||
@ -1626,7 +1677,7 @@ implementation
|
||||
(m_tp_procvar in aktmodeswitches) then
|
||||
begin
|
||||
doconv:=tc_proc_2_procvar;
|
||||
if proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to)) then
|
||||
if proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),false) then
|
||||
b:=1;
|
||||
end
|
||||
else
|
||||
@ -1808,8 +1859,9 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.53 2001-10-25 21:22:40 peter
|
||||
* calling convention rewrite
|
||||
Revision 1.54 2001-10-28 17:22:25 peter
|
||||
* allow assignment of overloaded procedures to procvars when we know
|
||||
which procedure to take
|
||||
|
||||
Revision 1.52 2001/10/22 21:21:09 peter
|
||||
* allow enum(enum)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user