浏览代码

* Delphi-mode calling without parenthesis

Sven/Sarah Barth 4 年之前
父节点
当前提交
2cc621618a
共有 6 个文件被更改,包括 53 次插入6 次删除
  1. 17 2
      compiler/ncal.pas
  2. 9 1
      compiler/ncnv.pas
  3. 8 1
      compiler/ngenutil.pas
  4. 3 1
      compiler/nld.pas
  5. 12 1
      compiler/nutils.pas
  6. 4 0
      compiler/pexpr.pas

+ 17 - 2
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;

+ 9 - 1
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

+ 8 - 1
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;
 

+ 3 - 1
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

+ 12 - 1
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;

+ 4 - 0
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