Browse Source

+ add a mode Delphi equivalent for tanonfunc56 to check whether overload selection works correctly

Sven/Sarah Barth 3 years ago
parent
commit
7bb1b12b4f
1 changed files with 122 additions and 0 deletions
  1. 122 0
      tests/test/tanonfunc60.pp

+ 122 - 0
tests/test/tanonfunc60.pp

@@ -0,0 +1,122 @@
+{ the mode ObjFPC equivalent is tanonfunc56 }
+
+program tanonfunc60;
+
+{$mode delphi}{$H+}
+{$modeswitch functionreferences}
+{$modeswitch anonymousfunctions}
+{$modeswitch nestedprocvars}
+
+type
+  TTestProc = procedure;
+  TTestProcRef = reference to procedure;
+  TTestMethod = procedure of object;
+  TTestNested = procedure is nested;
+
+  TTest = class
+    f: LongInt;
+
+    function Test1(aArg: TTestProc): LongInt; overload;
+    function Test1(aArg: TTestMethod): LongInt; overload;
+    function Test1(aArg: TTestNested): LongInt; overload;
+
+    function Test2(aArg: TTestProc): LongInt; overload;
+    function Test2(aArg: TTestMethod): LongInt; overload;
+    function Test2(aArg: TTestProcRef): LongInt; overload;
+
+    function Test3(aArg: TTestProc): LongInt; overload;
+    function Test3(aArg: TTestMethod): LongInt; overload;
+    function Test3(aArg: TTestProcRef): LongInt; overload;
+    function Test3(aArg: TTestNested): LongInt; overload;
+
+    procedure DoTest;
+  end;
+
+function TTest.Test1(aArg: TTestProc): LongInt;
+begin
+  Result := 1;
+end;
+
+function TTest.Test1(aArg: TTestMethod): LongInt;
+begin
+  Result := 2;
+end;
+
+function TTest.Test1(aArg: TTestNested): LongInt;
+begin
+  Result := 3;
+end;
+
+function TTest.Test2(aArg: TTestProc): LongInt;
+begin
+  Result := 1;
+end;
+
+function TTest.Test2(aArg: TTestMethod): LongInt;
+begin
+  Result := 2;
+end;
+
+function TTest.Test2(aArg: TTestProcRef): LongInt;
+begin
+  Result := 3;
+end;
+
+function TTest.Test3(aArg: TTestProc): LongInt;
+begin
+  Result := 1;
+end;
+
+function TTest.Test3(aArg: TTestMethod): LongInt;
+begin
+  Result := 2;
+end;
+
+function TTest.Test3(aArg: TTestProcRef): LongInt;
+begin
+  Result := 3;
+end;
+
+function TTest.Test3(aArg: TTestNested): LongInt;
+begin
+  Result := 4;
+end;
+
+procedure TTest.DoTest;
+var
+  l: LongInt;
+begin
+  if Test1(procedure begin end) <> 1 then
+    Halt(1);
+  if Test1(procedure begin f := 42; end) <> 2 then
+    Halt(2);
+  if Test1(procedure begin l := 42; end) <> 3 then
+    Halt(3);
+
+  if Test2(procedure begin end) <> 1 then
+    Halt(4);
+  if Test2(procedure begin f := 42; end) <> 2 then
+    Halt(5);
+  if Test2(procedure begin l := 42; end) <> 3 then
+    Halt(6);
+
+  if Test3(procedure begin end) <> 1 then
+    Halt(7);
+  if Test3(procedure begin f := 42; end) <> 2 then
+    Halt(8);
+  if Test3(procedure begin l := 42; end) <> 3 then
+    Halt(9);
+  if Test3(TTestNested(procedure begin l := 42; end)) <> 4 then
+    Halt(10);
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  try
+    t.DoTest;
+  finally
+    t.Free;
+  end;
+end.