diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 8679793e4f..265d8cbd69 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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