From 2cc621618accab4ce12b8f5b34c5f883fa460b3b Mon Sep 17 00:00:00 2001 From: Sven/Sarah Barth Date: Sun, 11 Apr 2021 23:00:08 +0200 Subject: [PATCH] * Delphi-mode calling without parenthesis --- compiler/ncal.pas | 19 +++++++++++++++++-- compiler/ncnv.pas | 10 +++++++++- compiler/ngenutil.pas | 9 ++++++++- compiler/nld.pas | 4 +++- compiler/nutils.pas | 13 ++++++++++++- compiler/pexpr.pas | 4 ++++ 6 files changed, 53 insertions(+), 6 deletions(-) diff --git a/compiler/ncal.pas b/compiler/ncal.pas index e96763a3fd..59a0ee852b 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -2157,7 +2157,10 @@ implementation else begin loadp:=p; - refp:=ctemprefnode.create(ptemp) + refp:=ctemprefnode.create(ptemp); + { ensure that an invokable isn't called again } + if is_invokable(hdef) then + include(ttemprefnode(refp).flags,nf_load_procvar); end; add_init_statement(ptemp); add_init_statement(cassignmentnode.create( @@ -3628,6 +3631,7 @@ implementation statements : tstatementnode; converted_result_data : ttempcreatenode; calltype: tdispcalltype; + invokesym : tsym; begin result:=nil; candidates:=nil; @@ -3664,7 +3668,18 @@ implementation if codegenerror then exit; - procdefinition:=tabstractprocdef(right.resultdef); + if is_invokable(right.resultdef) then + begin + procdefinition:=get_invoke_procdef(tobjectdef(right.resultdef)); + if assigned(methodpointer) then + internalerror(2021041004); + methodpointer:=right; + { don't convert again when this is used as the self parameter } + include(right.flags,nf_load_procvar); + right:=nil; + end + else + procdefinition:=tabstractprocdef(right.resultdef); { Compare parameters from right to left } paraidx:=procdefinition.Paras.count-1; diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index ee52207f1a..1814873d7f 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -2528,7 +2528,15 @@ implementation convert on the procvar value. This is used to access the fields of a methodpointer } if not(nf_load_procvar in flags) and - not(resultdef.typ in [procvardef,recorddef,setdef]) then + not(resultdef.typ in [procvardef,recorddef,setdef]) and + not is_invokable(resultdef) and + { in case of interface assignments of invokables they'll be converted + to voidpointertype using an internal conversions; we must not call + the invokable in that case } + not ( + (nf_internal in flags) and + is_invokable(left.resultdef) + ) then maybe_call_procvar(left,true); if target_specific_general_typeconv then diff --git a/compiler/ngenutil.pas b/compiler/ngenutil.pas index 97b1eda7d5..78d9797d5c 100644 --- a/compiler/ngenutil.pas +++ b/compiler/ngenutil.pas @@ -334,6 +334,8 @@ implementation class procedure tnodeutils.sym_maybe_initialize(p: TObject; arg: pointer); + var + hp : tnode; begin if ((tsym(p).typ = localvarsym) or { check staticvarsym for record management opeators and for objects @@ -358,7 +360,10 @@ implementation ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef)) ) then begin - addstatement(tstatementnode(arg^),initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false)); + hp:=cloadnode.create(tsym(p),tsym(p).owner); + { ensure that a function reference is not converted to a call } + include(hp.flags,nf_load_procvar); + addstatement(tstatementnode(arg^),initialize_data_node(hp,false)); end; end; @@ -431,6 +436,8 @@ implementation hp:=cloadnode.create(sym,sym.owner); if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst); + { ensure that a function reference interface is not converted to a call } + include(hp.flags,nf_load_procvar); addstatement(stat,finalize_data_node(hp)); end; diff --git a/compiler/nld.pas b/compiler/nld.pas index 51acb099eb..f66462273f 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -674,7 +674,8 @@ implementation { tp procvar support, when we don't expect a procvar then we need to call the procvar } - if (left.resultdef.typ<>procvardef) then + if (left.resultdef.typ<>procvardef) and + not is_invokable(left.resultdef) then maybe_call_procvar(right,true); { assignments to formaldefs and open arrays aren't allowed } @@ -808,6 +809,7 @@ implementation when trying to assign the result of a procedure, so give a better error message, see also #19122 } if (left.resultdef.typ<>procvardef) and + not is_invokable(left.resultdef) and (right.nodetype=calln) and is_void(right.resultdef) then CGMessage(type_e_procedures_return_no_value) else if nf_internal in flags then diff --git a/compiler/nutils.pas b/compiler/nutils.pas index be76d4cf71..c41f8a9ea9 100644 --- a/compiler/nutils.pas +++ b/compiler/nutils.pas @@ -477,7 +477,18 @@ implementation hp : tnode; begin result:=false; - if (p1.resultdef.typ<>procvardef) or + if not (p1.resultdef.typ in [procvardef,objectdef]) or + ( + (p1.resultdef.typ=objectdef) and + ( + not is_invokable(p1.resultdef) or + (nf_load_procvar in p1.flags) or + not ( + is_funcref(p1.resultdef) or + invokable_has_argless_invoke(tobjectdef(p1.resultdef)) + ) + ) + ) or (tponly and not(m_tp_procvar in current_settings.modeswitches)) then exit; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 86fad077ca..ef3bf4be2e 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -984,6 +984,9 @@ implementation end else p1:=load_self_node; + { don't try to call the invokable again } + if is_invokable(tdef(st.defowner)) then + include(p1.flags,nf_load_procvar); { We are calling a member } maybe_load_methodpointer:=true; end; @@ -2790,6 +2793,7 @@ implementation begin if not searchsym_in_class(tobjectdef(p1.resultdef),tobjectdef(p1.resultdef),method_name_funcref_invoke_find,srsym,srsymtable,[]) then internalerror(2021040202); + include(p1.flags,nf_load_procvar); do_proc_call(srsym,srsymtable,tabstractrecorddef(p1.resultdef),false,again,p1,[],nil); end else if assigned(p1.resultdef) and