|
|
@@ -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
|
peter