mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 05:08:06 +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