mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 06:27:12 +01:00
* tp procvar handling fix for tb0448
This commit is contained in:
peter
parent
bd06dd902c
commit
23861a4e45
@ -643,6 +643,23 @@ implementation
|
||||
begin
|
||||
prevafterassn:=afterassignment;
|
||||
afterassignment:=false;
|
||||
aprocdef:=nil;
|
||||
|
||||
{ When we are expecting a procvar we also need
|
||||
to get the address in some cases }
|
||||
if assigned(getprocvardef) then
|
||||
begin
|
||||
if (block_type=bt_const) then
|
||||
getaddr:=true
|
||||
else
|
||||
if (m_tp_procvar in aktmodeswitches) then
|
||||
begin
|
||||
aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
|
||||
if assigned(aprocdef) then
|
||||
getaddr:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ want we only determine the address of }
|
||||
{ a subroutine ? }
|
||||
if not(getaddr) then
|
||||
@ -681,33 +698,35 @@ implementation
|
||||
end;
|
||||
end;
|
||||
p1:=ccallnode.create(para,tprocsym(sym),st,p1);
|
||||
include(p1.flags,nf_auto_inherited);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ address operator @: }
|
||||
if not assigned(p1) then
|
||||
begin
|
||||
if (st.symtabletype=withsymtable) and
|
||||
(st.defowner.deftype=objectdef) then
|
||||
begin
|
||||
p1:=tnode(twithsymtable(st).withrefnode).getcopy;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ we must provide a method pointer, if it isn't given, }
|
||||
{ it is self }
|
||||
if (st.symtabletype=objectsymtable) then
|
||||
case st.symtabletype of
|
||||
withsymtable :
|
||||
begin
|
||||
if (st.defowner.deftype=objectdef) then
|
||||
p1:=tnode(twithsymtable(st).withrefnode).getcopy;
|
||||
end;
|
||||
objectsymtable :
|
||||
begin
|
||||
{ we must provide a method pointer, if it isn't given, }
|
||||
{ it is self }
|
||||
p1:=cselfnode.create(tobjectdef(st.defowner));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Retrieve info which procvar to call. For tp_procvar the
|
||||
aprocdef is already loaded above so we can reuse it }
|
||||
if not assigned(aprocdef) and
|
||||
assigned(getprocvardef) then
|
||||
aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
|
||||
|
||||
{ generate a methodcallnode or proccallnode }
|
||||
{ we shouldn't convert things like @tcollection.load }
|
||||
if assigned(getprocvardef) then
|
||||
aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef)
|
||||
else
|
||||
aprocdef:=nil;
|
||||
p2:=cloadnode.create_procvar(sym,aprocdef,st);
|
||||
if assigned(p1) and
|
||||
(p1.nodetype<>typen) then
|
||||
@ -720,38 +739,42 @@ implementation
|
||||
afterassignment:=prevafterassn;
|
||||
end;
|
||||
|
||||
procedure handle_procvar(pv : tprocvardef;var p2 : tnode; getaddr: boolean);
|
||||
|
||||
procedure doconv(procvar : tprocvardef;var t : tnode);
|
||||
var
|
||||
hp : tnode;
|
||||
currprocdef : tprocdef;
|
||||
begin
|
||||
hp:=nil;
|
||||
currprocdef:=tcallnode(t).symtableprocentry.search_procdef_byprocvardef(procvar);
|
||||
if assigned(currprocdef) then
|
||||
begin
|
||||
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);
|
||||
t.destroy;
|
||||
t:=hp;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
|
||||
var
|
||||
hp,hp2 : tnode;
|
||||
hpp : ^tnode;
|
||||
currprocdef : tprocdef;
|
||||
begin
|
||||
if ((m_tp_procvar in aktmodeswitches) or
|
||||
not getaddr) then
|
||||
if (p2.nodetype=calln) and
|
||||
{ a procvar can't have parameters! }
|
||||
not assigned(tcallnode(p2).left) then
|
||||
doconv(pv,p2)
|
||||
else
|
||||
if (p2.nodetype=typeconvn) and
|
||||
(ttypeconvnode(p2).left.nodetype=calln) and
|
||||
if not assigned(pv) then
|
||||
internalerror(200301121);
|
||||
if (m_tp_procvar in aktmodeswitches) then
|
||||
begin
|
||||
hp:=p2;
|
||||
hpp:=@p2;
|
||||
while assigned(hp) and
|
||||
(hp.nodetype=typeconvn) do
|
||||
begin
|
||||
hp:=ttypeconvnode(hp).left;
|
||||
{ save orignal address of the old tree so we can replace the node }
|
||||
hpp:=@hp;
|
||||
end;
|
||||
if (hp.nodetype=calln) and
|
||||
{ a procvar can't have parameters! }
|
||||
not assigned(tcallnode(ttypeconvnode(p2).left).left) then
|
||||
doconv(pv,ttypeconvnode(p2).left);
|
||||
not assigned(tcallnode(hp).left) then
|
||||
begin
|
||||
currprocdef:=tcallnode(hp).symtableprocentry.search_procdef_byprocvardef(pv);
|
||||
if assigned(currprocdef) then
|
||||
begin
|
||||
hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
|
||||
if (po_methodpointer in pv.procoptions) then
|
||||
tloadnode(hp2).set_mp(tnode(tcallnode(hp).methodpointer).getcopy);
|
||||
hp.destroy;
|
||||
{ replace the old callnode with the new loadnode }
|
||||
hpp^:=hp2;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -831,7 +854,7 @@ implementation
|
||||
getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
|
||||
p2:=comp_expr(true);
|
||||
if assigned(getprocvardef) then
|
||||
handle_procvar(getprocvardef,p2,getaddr);
|
||||
handle_procvar(getprocvardef,p2);
|
||||
tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
|
||||
include(tcallnode(p1).flags,nf_isproperty);
|
||||
getprocvardef:=nil;
|
||||
@ -932,17 +955,8 @@ implementation
|
||||
procsym:
|
||||
begin
|
||||
do_proc_call(sym,sym.owner,
|
||||
(getaddr and not(token in [_CARET,_POINT])) or
|
||||
(assigned(getprocvardef) and
|
||||
((block_type=bt_const) or
|
||||
((m_tp_procvar in aktmodeswitches) and
|
||||
(proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef)>te_incompatible)
|
||||
)
|
||||
)
|
||||
),again,p1);
|
||||
if (block_type=bt_const) and
|
||||
assigned(getprocvardef) then
|
||||
handle_procvar(getprocvardef,p1,getaddr);
|
||||
(getaddr and not(token in [_CARET,_POINT])),
|
||||
again,p1);
|
||||
{ we need to know which procedure is called }
|
||||
do_resulttypepass(p1);
|
||||
{ now we know the real method e.g. we can check for a class method }
|
||||
@ -1275,17 +1289,8 @@ implementation
|
||||
assigned(aktprocsym) and
|
||||
(po_classmethod in aktprocdef.procoptions);
|
||||
do_proc_call(srsym,srsymtable,
|
||||
(getaddr and not(token in [_CARET,_POINT])) or
|
||||
(assigned(getprocvardef) and
|
||||
((block_type=bt_const) or
|
||||
((m_tp_procvar in aktmodeswitches) and
|
||||
(proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef)>te_incompatible)
|
||||
)
|
||||
)
|
||||
),again,p1);
|
||||
if (block_type=bt_const) and
|
||||
assigned(getprocvardef) then
|
||||
handle_procvar(getprocvardef,p1,getaddr);
|
||||
(getaddr and not(token in [_CARET,_POINT])),
|
||||
again,p1);
|
||||
{ we need to know which procedure is called }
|
||||
if possible_error then
|
||||
begin
|
||||
@ -1793,6 +1798,9 @@ implementation
|
||||
p1:=ctypenode.create(htype);
|
||||
end;
|
||||
do_member_read(false,sym,p1,again);
|
||||
{ Add flag to indicate that inherited is used }
|
||||
if p1.nodetype=calln then
|
||||
include(p1.flags,nf_auto_inherited);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -2220,7 +2228,7 @@ implementation
|
||||
getprocvardef:=tprocvardef(p1.resulttype.def);
|
||||
p2:=sub_expr(opcompare,true);
|
||||
if assigned(getprocvardef) then
|
||||
handle_procvar(getprocvardef,p2,true);
|
||||
handle_procvar(getprocvardef,p2);
|
||||
getprocvardef:=nil;
|
||||
p1:=cassignmentnode.create(p1,p2);
|
||||
end;
|
||||
@ -2304,7 +2312,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.97 2003-01-05 22:44:14 peter
|
||||
Revision 1.98 2003-01-12 17:51:42 peter
|
||||
* tp procvar handling fix for tb0448
|
||||
|
||||
Revision 1.97 2003/01/05 22:44:14 peter
|
||||
* remove a lot of code to support typen in loadn-procsym
|
||||
|
||||
Revision 1.96 2002/12/11 22:40:36 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user