瀏覽代碼

* ensure that the correct overload is picked for function reference parameters
+ added tests

Sven/Sarah Barth 2 年之前
父節點
當前提交
d221f42a57
共有 3 個文件被更改,包括 124 次插入4 次删除
  1. 16 4
      compiler/htypechk.pas
  2. 54 0
      tests/test/tfuncref50.pp
  3. 54 0
      tests/test/tfuncref51.pp

+ 16 - 4
compiler/htypechk.pas

@@ -2983,11 +2983,17 @@ implementation
                returns a procdef we need to find the correct overloaded
                procdef that matches the expected procvar. The loadnode
                temporary returned the first procdef (PFV) }
-             if (def_to.typ=procvardef) and
+             if (
+                   (def_to.typ=procvardef) or
+                   is_funcref(def_to)
+                ) and
                 (currpt.left.nodetype=loadn) and
                 (currpt.left.resultdef.typ=procdef) then
                begin
-                 pdtemp:=tprocsym(Tloadnode(currpt.left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to));
+                 if def_to.typ=procvardef then
+                   pdtemp:=tprocsym(Tloadnode(currpt.left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to))
+                 else
+                   pdtemp:=tprocsym(tloadnode(currpt.left).symtableentry).find_procdef_byfuncrefdef(tobjectdef(def_to));
                  if assigned(pdtemp) then
                    begin
                      tloadnode(currpt.left).setprocdef(pdtemp);
@@ -2998,7 +3004,10 @@ implementation
 
              { same as above, but for the case that we have a proc-2-procvar
                conversion together with a load }
-             if (def_to.typ=procvardef) and
+             if (
+                   (def_to.typ=procvardef) or
+                   is_funcref(def_to)
+                ) and
                 (currpt.left.nodetype=typeconvn) and
                 (ttypeconvnode(currpt.left).convtype=tc_proc_2_procvar) and
                 (ttypeconvnode(currpt.left).totypedef=voidtype) and
@@ -3006,7 +3015,10 @@ implementation
                 (ttypeconvnode(currpt.left).left.nodetype=loadn) and
                 (ttypeconvnode(currpt.left).left.resultdef.typ=procdef) then
                begin
-                 pdtemp:=tprocsym(tloadnode(ttypeconvnode(currpt.left).left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to));
+                 if def_to.typ=procvardef then
+                   pdtemp:=tprocsym(tloadnode(ttypeconvnode(currpt.left).left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to))
+                 else
+                   pdtemp:=tprocsym(tloadnode(ttypeconvnode(currpt.left).left).symtableentry).find_procdef_byfuncrefdef(tobjectdef(def_to));
                  if assigned(pdtemp) then
                    begin
                      tloadnode(ttypeconvnode(currpt.left).left).setprocdef(pdtemp);

+ 54 - 0
tests/test/tfuncref50.pp

@@ -0,0 +1,54 @@
+program tfuncref50;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+type
+  TFunc = reference to function(aArg: LongInt): LongInt;
+
+function Test(aArg: TFunc): LongInt;
+begin
+  Result := aArg(42);
+end;
+
+type
+  TTest = class
+    function Method(aArg: String): LongInt; overload;
+    function Method(aArg: LongInt): LongInt; overload;
+    procedure DoTest;
+  end;
+
+function TTest.Method(aArg: String): LongInt;
+begin
+  Result := 1;
+end;
+
+function TTest.Method(aArg: LongInt): LongInt;
+begin
+  Result := 2;
+end;
+
+procedure TTest.DoTest;
+begin
+  Test(Method);
+end;
+
+function Func(aArg: String): LongInt; overload;
+begin
+  Result := 1;
+end;
+
+function Func(aArg: LongInt): LongInt; overload;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.DoTest;
+  t.Free;
+  if Test(Func) <> 2 then
+    Halt(2);
+end.

+ 54 - 0
tests/test/tfuncref51.pp

@@ -0,0 +1,54 @@
+program tfuncref51;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+type
+  TFunc = reference to function(aArg: LongInt): LongInt;
+
+function Test(aArg: TFunc): LongInt;
+begin
+  Result := aArg(42);
+end;
+
+type
+  TTest = class
+    function Method(aArg: String): LongInt; overload;
+    function Method(aArg: LongInt): LongInt; overload;
+    procedure DoTest;
+  end;
+
+function TTest.Method(aArg: String): LongInt;
+begin
+  Result := 1;
+end;
+
+function TTest.Method(aArg: LongInt): LongInt;
+begin
+  Result := 2;
+end;
+
+procedure TTest.DoTest;
+begin
+  Test(@Method);
+end;
+
+function Func(aArg: String): LongInt; overload;
+begin
+  Result := 1;
+end;
+
+function Func(aArg: LongInt): LongInt; overload;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.DoTest;
+  t.Free;
+  if Test(@Func) <> 2 then
+    Halt(2);
+end.