mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 18:24:19 +02:00
+ add a mode Delphi equivalent for tanonfunc56 to check whether overload selection works correctly
This commit is contained in:
parent
eaeb8b70ff
commit
7bb1b12b4f
122
tests/test/tanonfunc60.pp
Normal file
122
tests/test/tanonfunc60.pp
Normal file
@ -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.
|
Loading…
Reference in New Issue
Block a user