+ add tests for function references, anonymous functions and C-blocks

tests/test/tanonfunc1.pp

@@ -0,0 +1,36 @@
+{ anonymous functions can be called like nested functions }
+
+program tanonfunc1;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+procedure Test;
+var
+  v: LongInt;
+begin
+  v := 0;
+  procedure begin v := 1; end();
+  if v <> 1 then
+    Halt(4);
+  procedure(aArg: LongInt) begin v := aArg; end(2);
+  if v <> 2 then
+    Halt(5);
+  if function(aArg: LongInt): LongInt begin Result := aArg; end(3) <> 3 then
+    Halt(6);
+end;
+
+var
+  v: LongInt;
+begin
+  v := 0;
+  procedure begin v := 1; end();
+  if v <> 1 then
+    Halt(1);
+  procedure(aArg: LongInt) begin v := aArg; end(2);
+  if v <> 2 then
+    Halt(2);
+  if function(aArg: LongInt): LongInt begin Result := aArg; end(3) <> 3 then
+    Halt(3);
+  Test;
+end.

tests/test/tanonfunc10.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+{ an anonymous function referencing a local parent variable can not be assigned
+  to a procedure variable }
+
+program tanonfunc10;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TTestFunc = function: LongInt;
+
+procedure Test;
+var
+  i: LongInt;
+  tf: TTestFunc;
+begin
+  tf := function: LongInt begin Result := i; end;
+end;
+
+begin
+
+end.

tests/test/tanonfunc11.pp

@@ -0,0 +1,29 @@
+{ %FAIL }
+
+{ an anonymous function referencing a local variable can not be assigned to a
+  method variable }
+
+program tanonfunc11;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TTestMethod = function: LongInt of object;
+
+  TTest = class
+    f: LongInt;
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+var
+  tm: TTestMethod;
+  i: LongInt;
+begin
+  tm := function: LongInt begin Result := i * f; end;
+end;
+
+begin
+
+end.

tests/test/tanonfunc12.pp

@@ -0,0 +1,24 @@
+program tanonfunc12;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test anonymous function in global scope }
+
+type
+  tproc = reference to procedure;
+
+var
+  i: longint;
+  p: tproc;
+begin
+  p := procedure
+  begin
+    i := 123;
+  end;
+  p();
+  if i <> 123 then
+    halt(1);
+end.
+

tests/test/tanonfunc13.pp

@@ -0,0 +1,33 @@
+program tanonfunc13;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test variable capture }
+
+type
+  tintproc = reference to procedure(x: longint);
+
+var
+  acc: longint;
+
+function foo(z: longint): tintproc;
+var
+  y: integer;
+begin
+  y := 100;
+  result := procedure(x: longint) begin
+    acc := x + y + z;
+  end;
+end;
+
+var
+  p: tintproc;
+begin
+  p := foo(20);
+  p(3);
+  if acc <> 123 then
+    halt(1);
+end.
+

tests/test/tanonfunc14.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tanonfunc14;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ verify that "ClassName" is not available even if the anonymous function is
+  converted to a class instance method }
+
+type
+  tstrfunc = reference to function : string;
+
+function Test: tstrfunc;
+begin
+  Result := function: string begin result := classname; end;
+end;
+
+var
+  f: tstrfunc;
+begin
+  f := Test;
+  writeln( f() )
+end.
+

tests/test/tanonfunc15.pp

@@ -0,0 +1,32 @@
+program tanonfunc15;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ "ClassName" inside an anonymous function inside a method returns the
+  "ClassName" of the surrounding class }
+
+type
+  tstrfunc = reference to function : string;
+
+  TTest = class
+    function Test: tstrfunc;
+  end;
+
+function TTest.Test: tstrfunc;
+begin
+  Result := function: string begin result := classname; end;
+end;
+
+var
+  f: tstrfunc;
+  t: TTest;
+begin
+  t := TTest.Create;
+  f := t.Test;
+  if f() <> 'TTest' then
+    Halt(1);
+  t.Free;
+end.
+

tests/test/tanonfunc16.pp

@@ -0,0 +1,66 @@
+program tanonfunc16;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test using 'self' to access containing class from anonymous function }
+
+type
+  TProc = reference to procedure;
+
+  TTest = class
+	X: Integer;
+	property PX: Integer read X;
+	procedure Bar;
+	function Foo: TProc;
+  end;
+
+var
+  i: Integer;
+
+function OverloadTest(const O: TObject): Boolean; overload;
+begin
+  Result := False
+end;
+
+function OverloadTest(const O: TTest): Boolean; overload;
+begin
+  Result := True;
+end;
+
+function TTest.Foo: TProc;
+begin
+  Result := procedure begin
+    if not (self is TTest) then
+      halt(1);
+	if ClassName <> 'TTest' then
+      halt(2);
+	if not OverloadTest(self) then
+      halt(4);
+    X := 42;
+    if PX <> 42 then
+      halt(5);
+	Bar;
+    if i <> 43 then
+      halt(6);
+  end;
+end;
+
+procedure TTest.Bar;
+begin
+  i := X + 1;
+end;
+
+var
+  Obj: TTest;
+  Proc: TProc;
+begin
+  Obj := TTest.Create;
+  Proc := Obj.Foo;
+  Proc();
+  if Obj.X <> 42 then
+    halt(7);
+  Obj.Free;
+end.
+

tests/test/tanonfunc17.pp

@@ -0,0 +1,33 @@
+program tanonfunc17;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test maintaining state between calls }
+
+type
+  TIntFunc = reference to function: Integer;
+
+function Foo: TIntFunc;
+var
+  i: Integer;
+begin
+  Result := function: Integer
+  begin
+    Result := i;
+    Inc(i);
+  end;
+  i := 100;
+end;
+
+var
+  F: TIntFunc;
+  i: Integer;
+begin
+  F := Foo();
+  for i := 0 to 9 do
+    if F() <> (i + 100) then
+      halt(i);
+end.
+

tests/test/tanonfunc18.pp

@@ -0,0 +1,36 @@
+program tanonfunc18;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test independent state when multiple functions are created }
+
+type
+  TIntFunc = reference to function: Integer;
+
+function Foo: TIntFunc;
+var
+  i: Integer;
+begin
+  Result := function: Integer
+  begin
+    Result := i;
+    Inc(i);
+  end;
+  i := 100;
+end;
+
+var
+  F1, F2: TIntFunc;
+  i: Integer;
+begin
+  F1 := Foo();
+  F2 := Foo();
+  for i := 0 to 4 do
+    F1();
+  for i := 0 to 9 do
+    if F1() <> F2() + 5 then
+      halt(1);
+end.
+

tests/test/tanonfunc19.pp

@@ -0,0 +1,86 @@
+program tanonfunc19;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ when the capture object is freed non-managed members aren't freed }
+
+type
+  TProc = reference to procedure;
+
+  TTest1 = class
+    f: LongInt;
+    destructor Destroy; override;
+  end;
+
+  ITest = interface
+    function GetValue: LongInt;
+  end;
+
+  TTest2 = class(TInterfacedObject, ITest)
+    f: LongInt;
+    function GetValue: LongInt;
+    destructor Destroy; override;
+  end;
+
+var
+  Test1Destr: Boolean = False;
+  Test2Destr: Boolean = False;
+
+destructor TTest1.Destroy;
+begin
+  Test1Destr := True;
+  inherited;
+end;
+
+function TTest2.GetValue: LongInt;
+begin
+  Result := f;
+end;
+
+destructor TTest2.Destroy;
+begin
+  Test2Destr := True;
+  inherited;
+end;
+
+var
+  t: TTest1;
+
+function Test: TProc;
+var
+  test1: TTest1;
+  test2: TTest2;
+  intf: ITest;
+begin
+  test1 := TTest1.Create;
+  test1.f := 42;
+  test2 := TTest2.Create;
+  test2.f := 21;
+  intf := test2;
+  t := test1;
+  Result := procedure
+            begin
+              test1.f := intf.GetValue;
+            end;
+end;
+
+procedure DoTest;
+var
+  p: TProc;
+begin
+  p := Test;
+  p();
+  p := Nil;
+end;
+
+begin
+  DoTest;
+  if Test1Destr then
+    Halt(1);
+  if not Test2Destr then
+    Halt(2);
+  t.Free;
+end.
+

tests/test/tanonfunc2.pp

@@ -0,0 +1,36 @@
+{ anonymous functions can be called like nested functions }
+
+program tanonfunc2;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+
+procedure Test;
+var
+  v: LongInt;
+begin
+  v := 0;
+  procedure begin v := 1; end();
+  if v <> 1 then
+    Halt(4);
+  procedure(aArg: LongInt) begin v := aArg; end(2);
+  if v <> 2 then
+    Halt(5);
+  if function(aArg: LongInt): LongInt begin Result := aArg; end(3) <> 3 then
+    Halt(6);
+end;
+
+var
+  v: LongInt;
+begin
+  v := 0;
+  procedure begin v := 1; end();
+  if v <> 1 then
+    Halt(1);
+  procedure(aArg: LongInt) begin v := aArg; end(2);
+  if v <> 2 then
+    Halt(2);
+  if function(aArg: LongInt): LongInt begin Result := aArg; end(3) <> 3 then
+    Halt(3);
+  Test;
+end.

tests/test/tanonfunc20.pp

@@ -0,0 +1,40 @@
+program tanonfunc20;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test accessing parent classes across unit boundaries }
+
+uses uanonfunc20;
+
+type
+  tintfunc = reference to function: longint;
+
+  tsub = class(tbase)
+    y: longint;
+    procedure bar;
+  end;
+
+procedure tsub.bar;
+var
+  f: tintfunc;
+begin
+  f := function: longint
+  begin
+    result := x + y;
+  end;
+  y := 456;
+  writeln(x, ' ', y, ' ', f());
+  if f() <> 579 then
+    halt(1);
+end;
+
+var
+  c: tsub;
+begin
+  c := tsub.create;
+  c.bar;
+  c.free;
+end.
+

tests/test/tanonfunc21.pp

@@ -0,0 +1,26 @@
+program tanonfunc21;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test passing references across unit boundaries }
+
+uses uanonfunc21;
+
+procedure foo;
+var
+  i: Integer;
+begin
+  bar(procedure
+    begin
+      i := 123;
+    end);
+  if i <> 123 then
+    halt(1);
+end;
+
+begin
+  foo;
+end.
+

tests/test/tanonfunc22.pp

@@ -0,0 +1,10 @@
+program tanonfunc22;
+
+{ test accessing references across impementation/interface boundaries }
+
+uses uanonfunc22;
+
+begin
+  foo;
+end.
+

tests/test/tanonfunc23.pp

@@ -0,0 +1,54 @@
+program tanonfunc23;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test calling into overloaded routines and creating anonymous methods in them }
+
+type
+  tproc = reference to procedure;
+  tcharproc = reference to procedure(c: char);
+  tintproc = reference to procedure(i: longint);
+
+procedure baz(p: tproc);
+begin
+  p();
+end;
+
+procedure bar(p: tcharproc); overload;
+begin
+  baz(procedure
+    begin
+      p('a');
+    end);
+end;
+
+procedure bar(p: tintproc); overload;
+begin
+  baz(procedure
+    begin
+      p(123);
+    end);
+end;
+
+procedure foo;
+var
+  acc: integer;
+begin
+  acc := 0;
+  bar(procedure(c: char)
+    begin
+      if c = 'a' then inc(acc);
+    end);
+  bar(procedure(i: longint)
+    begin
+      if i = 123 then inc(acc);
+    end);
+  if acc <> 2 then halt(1);
+end;
+
+begin
+  foo;
+end.
+

tests/test/tanonfunc24.pp

@@ -0,0 +1,53 @@
+program tanonfunc24;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test anonymous methods with extremely long symbol names }
+
+type
+  tproc = reference to procedure;
+
+  tprocrefname_01234567890123456789 = reference to procedure(c: char; i: longint);
+
+  tlongclassname_01234567890123456789 = class
+	  procedure longmethodname_0123456789(p: tprocrefname_01234567890123456789);
+  end;
+
+procedure foo(p: tproc);
+begin
+  p();
+end;
+
+procedure tlongclassname_01234567890123456789.longmethodname_0123456789(
+  p: tprocrefname_01234567890123456789);
+begin
+  foo(
+	procedure
+	begin
+	  p('a', 123);
+	end);
+end;
+
+procedure bar;
+var
+  cls: tlongclassname_01234567890123456789;
+  val: Integer;
+begin
+  cls := tlongclassname_01234567890123456789.create;
+  cls.longmethodname_0123456789(
+    procedure(c: char; i: longint)
+    begin
+      if (c <> 'a') or (i <> 123) then
+        halt(1);
+      val := i;
+    end);
+  cls.free;
+  if val <> 123 then
+    halt(1);
+end;
+
+begin
+  bar;
+end.

tests/test/tanonfunc25.pp

@@ -0,0 +1,40 @@
+{ %FAIL }
+
+program tanonfunc25;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+{$modeswitch nestedprocvars}
+
+{ verify that nested procedures aren't accessible from anonymous functions
+  in the captured procedure }
+
+type
+  tproc = reference to procedure;
+
+procedure baz(p: tproc);
+begin
+  p();
+end;
+
+procedure foo;
+
+  procedure bar;
+  begin
+  end;
+
+type
+  TNested = procedure is nested;
+
+begin
+  bar;
+  baz(procedure begin bar end);
+  baz(procedure var n: TNested; begin n := @bar; end);
+end;
+
+begin
+  foo;
+end.
+
+

tests/test/tanonfunc26.pp

@@ -0,0 +1,46 @@
+{ %target=darwin,iphonesim }
+{ %skipcpu=powerpc,powerpc64 }
+
+program tanonfunc26;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test using anonymous functions and C blocks together }
+
+type
+  TAnon = reference to function(l: longint): longint;
+  TBlock = reference to function(l: longint): longint; cdecl; cblock;
+
+function TestBlock(b: TBlock; l: longint): longint;
+begin
+  Result := b(l);
+end;
+
+function GlobalProc(l: longint): longint;
+begin
+  Result := l + 2;
+end;
+
+function TestAnonFunc: longint;
+var
+  a: TAnon;
+begin
+  a := function(l: longint): longint
+    begin
+      Result := l + 1;
+    end;
+  TestAnonFunc := a(10);
+end;
+
+var
+  Block: TBlock;
+begin
+  Block := @GlobalProc;
+  if TestBlock(Block, 10) <> 12 then
+    halt(1);
+  if TestAnonFunc <> 11 then
+    halt(2);
+end.

tests/test/tanonfunc27.pp

@@ -0,0 +1,35 @@
+program tanonfunc27;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test accessing a captured variable from both a nested procedure and an anonymous function }
+
+type
+  tproc = reference to procedure;
+
+procedure foo;
+var
+  i: Integer;
+
+  procedure inner;
+  begin
+    inc(i, 20);
+  end;
+
+begin
+  i := 100;
+  tproc(
+    procedure begin
+      inc(i, 3);
+    end)();
+  inner;
+  if i <> 123 then
+    halt(1);
+end;
+
+begin
+  foo;
+end.
+

tests/test/tanonfunc28.pp

@@ -0,0 +1,79 @@
+program tanonfunc28;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test try..except blocks nested in anonymous methods }
+
+uses
+  SysUtils;
+
+var
+  Acc: Integer;
+
+type
+  TProc = reference to procedure;
+
+procedure CallProc(AProc: TProc);
+begin
+  AProc();
+end;
+
+procedure PlainException;
+begin
+  try
+    raise Exception.Create('');
+  except on E: Exception do
+    Inc(Acc, 4);
+  end;
+end;
+
+procedure RaisedException;
+begin
+  try
+    CallProc(
+      procedure
+      begin
+        raise Exception.Create('');
+      end);
+  except on E: Exception do
+    Inc(Acc, 30);
+  end;
+end;
+
+procedure NestedExceptionHandler;
+begin
+  CallProc(
+    procedure
+    begin
+      try
+        raise Exception.Create('');
+      except on E: Exception do
+        Inc(Acc, 200);
+      end;
+    end);
+end;
+
+procedure TouchInNestedExceptionHandler;
+begin
+  CallProc(
+    procedure
+    begin
+      try
+        raise Exception.Create('');
+      except on E: Exception do
+        if E.Message = '' then
+          Inc(Acc, 1000);
+      end;
+    end);
+end;
+
+begin
+  PlainException;
+  RaisedException;
+  NestedExceptionHandler;
+  TouchInNestedExceptionHandler;
+  if Acc <> 1234 then
+    halt(1);
+end.

tests/test/tanonfunc29.pp

@@ -0,0 +1,49 @@
+program tanonfunc29;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test accessing parent classes across unit boundaries and multiple nestings }
+
+uses uanonfunc20;
+
+type
+  tintfunc = reference to function: longint;
+
+  tsub = class(tbase)
+    y: longint;
+    procedure bar;
+  end;
+
+function callfunc(afunc: tintfunc): longint;
+begin
+  result := afunc()
+end;
+
+procedure tsub.bar;
+var
+  z: longint;
+begin
+  y := 456;
+  z := callfunc(
+    function: longint
+    begin
+      result := x + y + callfunc(
+        function: longint
+        begin
+          result := x + 87
+        end);
+    end);
+  if z <> 789 then
+    halt(1);
+end;
+
+var
+  c: tsub;
+begin
+  c := tsub.create;
+  c.bar;
+  c.free;
+end.
+

tests/test/tanonfunc3.pp

@@ -0,0 +1,72 @@
+{ anonymous functions that don't capture any local variables can be assigned
+  to function/procedure variables }
+
+program tanonfunc3;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TFunction = function(aArg: LongInt): LongInt;
+  TProcedure = procedure(aArg: LongInt);
+
+  TTest = class
+    procedure Test;
+  end;
+
+var
+  g: LongInt;
+
+procedure TTest.Test;
+var
+  f: TFunction;
+  p: TProcedure;
+begin
+  f := function(aArg: LongInt): LongInt begin Result := aArg; end;
+  if f(42) <> 42 then
+    Halt(5);
+  p := procedure(aArg: LongInt) begin g := aArg; end;
+  g := 0;
+  p(42);
+  if g <> 42 then
+    Halt(6);
+end;
+
+procedure Test;
+var
+  f: TFunction;
+  p: TProcedure;
+begin
+  f := function(aArg: LongInt): LongInt begin Result := aArg; end;
+  if f(42) <> 42 then
+    Halt(3);
+  p := procedure(aArg: LongInt) begin g := aArg; end;
+  g := 0;
+  p(42);
+  if g <> 42 then
+    Halt(4);
+end;
+
+var
+  f: TFunction;
+  p: TProcedure;
+  t: TTest;
+begin
+  f := function(aArg: LongInt): LongInt begin Result := aArg; end;
+  if f(42) <> 42 then
+    Halt(1);
+  p := procedure(aArg: LongInt) begin g := aArg; end;
+  g := 0;
+  p(42);
+  if g <> 42 then
+    Halt(2);
+
+  Test;
+
+  t := TTest.Create;
+  try
+    t.Test;
+  finally
+    t.Free;
+  end;
+end.

tests/test/tanonfunc30.pp

@@ -0,0 +1,33 @@
+program tanonfunc30;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test calling named function nested within an an anonymous method }
+
+type
+  TIntFunc = reference to function: Integer;
+
+function Foo: TIntFunc;
+begin
+  Result := function: Integer
+  var x: Integer;
+
+    procedure bar;
+    begin
+      Inc(x, 2);
+    end;
+
+  begin
+    x := 1;
+    bar;
+    Result := x;
+  end;
+end;
+
+begin
+  if foo()() <> 3 then
+    halt(1);
+end.
+

tests/test/tanonfunc31.pp

@@ -0,0 +1,74 @@
+program tanonfunc31;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test capturing a reference counted interface }
+
+type
+  TProc = reference to procedure;
+
+  IGetInt = interface
+    function GetInt: Integer;
+  end;
+
+  TTestObj = class(TInterfacedObject, IGetInt)
+    constructor Create;
+    destructor Destroy; override;
+    function GetInt: Integer;
+  end;
+
+var
+  IntfAlive: Boolean;
+
+constructor TTestObj.Create;
+begin
+  inherited;
+  IntfAlive := True;
+end;
+
+destructor TTestObj.Destroy;
+begin
+  IntfAlive := False;
+  inherited
+end;
+
+function TTestObj.GetInt: Integer;
+begin
+  Result := 123;
+end;
+
+function CaptureIntf(Intf: IGetInt): TProc;
+begin
+  Result := procedure
+  begin
+    if Intf.GetInt <> 123 then
+      Halt(1);
+  end;
+end;
+
+procedure Test;
+var
+  Intf: IGetInt;
+  P: TProc;
+begin
+  Intf := TTestObj.Create;
+  if not IntfAlive then
+    Halt(2);
+
+  P := CaptureIntf(Intf);
+  Intf := nil;
+  if not IntfAlive then
+    Halt(3);
+
+  P();
+  P := nil;
+  if IntfAlive then
+    Halt(4);
+end;
+
+begin
+  Test;
+end.
+

tests/test/tanonfunc32.pp

@@ -0,0 +1,36 @@
+{ %NORUN }
+
+program tanonfunc32;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ Test that there's no internal error when REGVAR optimizations are enabled }
+
+{$optimization regvar}
+
+type
+  TProc = reference to procedure;
+
+  TObj = class
+    Str: string;
+  end;
+
+procedure GlobalProc(AObj: TObj);
+
+  procedure NestedProc(AProc: TProc);
+  begin
+    AObj.Str := '';
+  end;
+
+begin
+  NestedProc(
+    procedure
+    begin
+      AObj.Str := '';
+    end)
+end;
+
+begin
+end.

tests/test/tanonfunc33.pp

@@ -0,0 +1,30 @@
+program tanonfunc33;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test generic anonymous method reference }
+
+type
+  TProc<T> = reference to procedure(Arg: T);
+
+procedure Foo;
+var
+  p: TProc<Integer>;
+  acc: Integer;
+begin
+  p := procedure(Arg: Integer)
+  begin
+    Inc(acc, Arg);
+  end;
+  acc := 1;
+  p(2);
+  if acc <> 3 then
+    halt(1);
+end;
+
+begin
+  Foo;
+end.
+

tests/test/tanonfunc34.pp

@@ -0,0 +1,30 @@
+program tanonfunc34;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test generic anonymous method reference }
+
+type
+  generic TProc<T> = reference to procedure(Arg: T);
+
+procedure Foo;
+var
+  p: specialize TProc<Integer>;
+  acc: Integer;
+begin
+  p := procedure(Arg: Integer)
+  begin
+    Inc(acc, Arg);
+  end;
+  acc := 1;
+  p(2);
+  if acc <> 3 then
+    halt(1);
+end;
+
+begin
+  Foo;
+end.
+

tests/test/tanonfunc35.pp

@@ -0,0 +1,54 @@
+program tanonfunc35;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test anonymous methods with calling conventions }
+
+type
+  TRec = record
+    l: longint;
+    c: ansichar;
+    b: boolean;
+    p: ^TRec;
+  end;
+
+  TCdeclFunc = reference to function(l: longint; r: TRec): longint cdecl;
+  TRegisterFunc = reference to function(l: longint; r: TRec): longint register;
+
+procedure Foo(aRec: TRec);
+var
+  cdeclFunc: TCdeclFunc;
+  registerFunc: TRegisterFunc;
+begin
+  cdeclFunc := function(l: longint; r: TRec): longint cdecl
+  begin
+    Result := l + r.l;
+    if r.c <> 'a' then
+      halt(1);
+  end;
+  if cdeclFunc(123, aRec) <> 246 then
+    halt(2);
+
+  registerFunc := function(l: longint; r: TRec): longint register
+  begin
+    Result := l + r.l;
+    if r.c <> 'a' then
+      halt(3);
+  end;
+  if registerFunc(321, aRec) <> 444 then
+    halt(4);
+end;
+
+var
+  r: TRec;
+begin
+  r.l := 123;
+  r.c := 'a';
+  r.b := False;
+  r.p := @r;
+  Foo(r);
+end.
+
+

tests/test/tanonfunc36.pp

@@ -0,0 +1,34 @@
+program tanonfunc36;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test loops / arrays }
+
+type
+  TIntFunc = reference to function: Integer;
+
+function CreateFunc(i: Integer): TIntFunc;
+begin
+  Result := function: Integer
+  begin
+    Result := i;
+  end;
+end;
+
+var
+  F: TIntFunc;
+  Funcs: array of TIntFunc;
+  Acc, i: Integer;
+begin
+  SetLength(Funcs, 10);
+  for i := Low(Funcs) to High(Funcs) do
+    Funcs[i] := CreateFunc(i);
+  Acc := 0;
+  for F in Funcs do
+    Inc(Acc, F());
+  if Acc <> 45 then
+    halt(acc);
+end.
+

tests/test/tanonfunc37.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+program tanonfunc37;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test local reference declaration }
+
+procedure Foo;
+type
+  TLocalProc = reference to procedure;
+var
+  P: TLocalProc;
+begin
+  P := procedure
+    begin
+    end;
+  P();
+end;
+
+begin
+  Foo;
+end.
+

tests/test/tanonfunc38.pp

@@ -0,0 +1,26 @@
+program tanonfunc38;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test generic local reference declaration }
+
+procedure Foo;
+type
+  TLocalFunc<T> = reference to function(arg: T): T;
+var
+  F: TLocalFunc<longint>;
+begin
+  F := function(arg: longint): longint
+    begin
+      Result := arg * arg;
+    end;
+  if F(5) <> 25 then
+    halt(1);
+end;
+
+begin
+  Foo;
+end.
+

tests/test/tanonfunc39.pp

@@ -0,0 +1,26 @@
+program tanonfunc39;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test generic local reference declaration }
+
+procedure Foo;
+type
+  generic TLocalFunc<T> = reference to function(arg: T): T;
+var
+  F: specialize TLocalFunc<longint>;
+begin
+  F := function(arg: longint): longint
+    begin
+      Result := arg * arg;
+    end;
+  if F(5) <> 25 then
+    halt(1);
+end;
+
+begin
+  Foo;
+end.
+

tests/test/tanonfunc4.pp

@@ -0,0 +1,72 @@
+{ anonymous functions that don't capture any local variables can be assigned
+  to function/procedure variables }
+
+program tanonfunc4;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+
+type
+  TFunction = function(aArg: LongInt): LongInt;
+  TProcedure = procedure(aArg: LongInt);
+
+  TTest = class
+    procedure Test;
+  end;
+
+var
+  g: LongInt;
+
+procedure TTest.Test;
+var
+  f: TFunction;
+  p: TProcedure;
+begin
+  f := function(aArg: LongInt): LongInt begin Result := aArg; end;
+  if f(42) <> 42 then
+    Halt(5);
+  p := procedure(aArg: LongInt) begin g := aArg; end;
+  g := 0;
+  p(42);
+  if g <> 42 then
+    Halt(6);
+end;
+
+procedure Test;
+var
+  f: TFunction;
+  p: TProcedure;
+begin
+  f := function(aArg: LongInt): LongInt begin Result := aArg; end;
+  if f(42) <> 42 then
+    Halt(3);
+  p := procedure(aArg: LongInt) begin g := aArg; end;
+  g := 0;
+  p(42);
+  if g <> 42 then
+    Halt(4);
+end;
+
+var
+  f: TFunction;
+  p: TProcedure;
+  t: TTest;
+begin
+  f := function(aArg: LongInt): LongInt begin Result := aArg; end;
+  if f(42) <> 42 then
+    Halt(1);
+  p := procedure(aArg: LongInt) begin g := aArg; end;
+  g := 0;
+  p(42);
+  if g <> 42 then
+    Halt(2);
+
+  Test;
+
+  t := TTest.Create;
+  try
+    t.Test;
+  finally
+    t.Free;
+  end;
+end.

tests/test/tanonfunc40.pp

@@ -0,0 +1,69 @@
+{ %NORUN }
+
+program tanonfunc40;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test advanced generics }
+
+type
+  M<T> = reference to function (const A: T): M<T>;
+
+type
+  G<T> = record
+    type M = reference to function (const A: T): M;
+  end;
+
+type
+  C<T> = class(TInterfacedObject, M<T>)
+    function Invoke(const A: T): M<T>;
+  end;
+
+function C<T>.Invoke(const A: T): M<T>;
+begin
+  Writeln(ClassName, '.Invoke(', A, ')');
+  Result := Self;
+end;
+
+type
+  R = record
+    procedure Foo;
+    procedure Foo<T>;
+  end;
+
+procedure R.Foo;
+type
+  Local<T> = reference to procedure (const X: T);
+var
+  Z: Local<Char>;
+  //AZ: reference to procedure (const X: T);
+begin
+  Z := procedure (const C: Char) begin
+    WriteLn('nmls: ', C)
+  end;
+  Z('Z')
+end;
+
+procedure R.Foo<T>;
+type
+  Local = reference to procedure (const X: T);
+var
+  l: Local;
+begin
+  l := procedure(const X: T)
+       begin
+       end;
+  l(Default(T));
+end;
+
+var
+  X: M<Integer>{G<Integer>.M};
+  Y: R;
+begin
+  X := C<Integer>.Create;
+  X(42)(777)(1024);
+
+  Y.Foo<LongInt>;
+end.

tests/test/tanonfunc41.pp

@@ -0,0 +1,71 @@
+{ %NORUN }
+
+program tanonfunc41;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+{$modeswitch advancedrecords}
+
+{ test advanced generics }
+
+type
+  generic M<T> = reference to function (const A: T): specialize M<T>;
+
+type
+  generic G<T> = record
+    type M = reference to function (const A: T): M;
+  end;
+
+type
+  generic C<T> = class(TInterfacedObject, specialize M<T>)
+    function Invoke(const A: T): specialize M<T>;
+  end;
+
+function C.Invoke(const A: T): specialize M<T>;
+begin
+  Writeln(ClassName, '.Invoke(', A, ')');
+  Result := Self;
+end;
+
+type
+  R = record
+    procedure Foo;
+    generic procedure Foo<T>;
+  end;
+
+procedure R.Foo;
+type
+  generic Local<T> = reference to procedure (const X: T);
+var
+  Z: specialize Local<Char>;
+// TODO: var AZ: reference to procedure (const X: T);
+begin
+  Z := procedure (const C: Char) begin
+    WriteLn('nmls: ', C)
+  end;
+  Z('Z')
+end;
+
+generic procedure R.Foo<T>;
+type
+  Local = reference to procedure (const X: T);
+var
+  l: Local;
+begin
+  l := procedure(const X: T)
+       begin
+       end;
+  l(Default(T));
+  // TODO: nameless routines in generics
+end;
+
+var
+  X: specialize M<Integer>{G<Integer>.M};
+  Y: R;
+begin
+  X := specialize C<Integer>.Create;
+  X(42)(777)(1024);
+
+  Y.Foo;
+end.

tests/test/tanonfunc42.pp

@@ -0,0 +1,27 @@
+{ %FAIL }
+
+program tanonfunc42;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test that capturing parent method's Result is rejected }
+
+type
+  tproc = reference to procedure;
+
+function Foo: Integer;
+var P: TProc;
+begin
+  Result := 0;
+  P := procedure
+  begin
+    Result := 1
+  end;
+end;
+
+begin
+  Foo;
+end.
+

tests/test/tanonfunc43.pp

@@ -0,0 +1,45 @@
+program tanonfunc43;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test capturing record and array variables }
+
+type
+  TIntFunc = reference to function: Integer;
+
+function TestCaptureArray: TIntFunc;
+var
+  A: array[0..15] of Integer;
+begin
+  Result := function: Integer
+    begin
+      Result := A[0] + A[1];
+    end;
+  A[0] := 1;
+  A[1] := 2;
+end;
+
+function TestCaptureRecord: TIntFunc;
+var
+  R: record
+    I1, I2: Integer;
+  end;
+begin
+  Result := function: Integer
+    begin
+      Result := R.I1 + R.I2;
+    end;
+  R.I1 := 1;
+  R.I2 := 2;
+end;
+
+begin
+  if TestCaptureArray()() <> 3 then
+    Halt(1);
+
+  if TestCaptureRecord()() <> 3 then
+    Halt(2);
+end.
+

tests/test/tanonfunc44.pp

@@ -0,0 +1,59 @@
+program tanonfunc44;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test capturing record and array arguments }
+
+type
+  TIntFunc = reference to function: Integer;
+
+  TIntArr = array[0..15] of Integer;
+  TIntRec = record
+    I1, I2: Integer;
+    P1, P2: Pointer;
+  end;
+
+function TestCaptureArray(A: TIntArr): TIntFunc;
+begin
+  Result := function: Integer
+    begin
+      Result := A[0] + A[1];
+    end;
+end;
+
+function TestCaptureRecord(R: TIntRec): TIntFunc;
+begin
+  Result := function: Integer
+    begin
+      Result := R.I1 + R.I2;
+    end;
+end;
+
+var
+  A: TIntArr;
+  R: TIntRec;
+  F: TIntFunc;
+begin
+  A[0] := 1;
+  A[1] := 2;
+  F := TestCaptureArray(A);
+  if F() <> 3 then
+    Halt(1);
+
+  A[0] := 3;
+  if F() <> 3 then
+    Halt(2);
+
+  R.I1 := 1;
+  R.I2 := 2;
+  F := TestCaptureRecord(R);
+  if F() <> 3 then
+    Halt(3);
+
+  R.I1 := 3;
+  if F() <> 3 then
+    Halt(3);
+end.
+

tests/test/tanonfunc45.pp

@@ -0,0 +1,30 @@
+{ %FAIL }
+
+program tanonfunc45;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test that capturing open array arguments is rejected }
+
+type
+  TIntFunc = reference to function: Integer;
+
+function TestCaptureArray(A: array of Integer): TIntFunc;
+begin
+  Result := function: Integer
+    var
+      I: Integer;
+    begin
+      Result := 0;
+      for I in A do
+        Inc(Result, I)
+    end;
+end;
+
+begin
+  if TestCaptureArray([1, 2, 3, 4])() <> 10 then
+    Halt(1);
+end.
+

tests/test/tanonfunc46.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tanonfunc46;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ var parameters can't be captured }
+
+type
+  TProc = reference to procedure;
+
+procedure Test(var aArg: LongInt);
+var
+  p: TProc;
+begin
+  p := procedure
+       begin
+         aArg := 42;
+       end;
+end;
+
+begin
+
+end.

tests/test/tanonfunc47.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tanonfunc47;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ out parameters can't be captured }
+
+type
+  TProc = reference to procedure;
+
+procedure Test(out aArg: LongInt);
+var
+  p: TProc;
+begin
+  p := procedure
+       begin
+         aArg := 42;
+       end;
+end;
+
+begin
+
+end.

tests/test/tanonfunc48.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tanonfunc48;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ var parameters can't be captured }
+
+type
+  TProc = reference to procedure;
+
+procedure Test(var aArg);
+var
+  p: TProc;
+begin
+  p := procedure
+       begin
+         PLongInt(@aArg)^ := 42;
+       end;
+end;
+
+begin
+
+end.

tests/test/tanonfunc49.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tanonfunc49;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ out parameters can't be captured }
+
+type
+  TProc = reference to procedure;
+
+procedure Test(out aArg);
+var
+  p: TProc;
+begin
+  p := procedure
+       begin
+         PLongInt(@aArg)^ := 42;
+       end;
+end;
+
+begin
+
+end.

tests/test/tanonfunc5.pp

@@ -0,0 +1,68 @@
+{ anonymous functions that capture nothing or Self can be assigned to method
+  variables }
+
+program tanonfunc5;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TTestMethod = function(aArg: LongInt): LongInt of object;
+
+  TTest = class
+    f: LongInt;
+    function Func: LongInt;
+    procedure Test;
+    property p1: LongInt read f;
+    property p2: LongInt read Func;
+  end;
+
+procedure TTest.Test;
+var
+  tm: TTestMethod;
+begin
+  tm := function(aArg: LongInt): LongInt begin Result := aArg + 5; end;
+  if tm(37) <> 42 then
+    Halt(2);
+
+  f := 2;
+  tm := function(aArg: LongInt): LongInt begin Result := f * aArg; end;
+  if tm(21) <> 42 then
+    Halt(3);
+
+  f := 3;
+  tm := function(aArg: LongInt): LongInt begin Result := p1 * aArg; end;
+  if tm(4) <> 12 then
+    Halt(4);
+
+  f := 4;
+  tm := function(aArg: LongInt): LongInt begin Result := Func * aArg; end;
+  if tm(5) <> 20 then
+    Halt(5);
+
+  f := 5;
+  tm := function(aArg: LongInt): LongInt begin Result := p2 * aArg; end;
+  if tm(3) <> 15 then
+    Halt(6);
+end;
+
+function TTest.Func: LongInt;
+begin
+  Result := f;
+end;
+
+var
+  t: TTest;
+  tm: TTestMethod;
+begin
+  tm := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tm(2) <> 4 then
+    Halt(1);
+
+  t := TTest.Create;
+  try
+    t.Test;
+  finally
+    t.Free;
+  end;
+end.

tests/test/tanonfunc50.pp

@@ -0,0 +1,48 @@
+{ %NORUN }
+
+program tanonfunc50;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test combining multiple levels of anonymous methods and nested
+  named procedures with variable capture.
+  Causes an internal compiler error in Delphi 10.4 (RSP-21518) }
+
+type
+  TProc = reference to procedure;
+
+procedure CallProc(AProc: TProc);
+begin
+  AProc();
+end;
+
+procedure OuterProc;
+begin
+  CallProc(
+    procedure
+
+      procedure NestedProc;
+      var
+        x, y, z: Integer;
+      begin
+        x := 0;
+        y := 1;
+        CallProc(
+          procedure
+          begin
+            x := 2;
+            z := 3;
+          end);
+      end;
+
+    begin
+    end);
+end;
+
+begin
+  OuterProc;
+end.
+
+

tests/test/tanonfunc51.pp

@@ -0,0 +1,21 @@
+{ in modes without modeswitch result the name of the result of an anonymous
+  function can be specified just as for operators }
+
+program tanonfunc51;
+
+{$mode fpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TFunc = function(aArg1, aArg2: LongInt): LongInt;
+
+var
+  f: TFunc;
+begin
+  f := function(aArg1, aArg2: LongInt) Res : LongInt
+       begin
+         Res := aArg1 + aArg2;
+       end;
+  if f(2, 3) <> 5 then
+    Halt(1);
+end.

tests/test/tanonfunc52.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ in modes with Result modeswitch the result identifier is required for
+  for anonymous functions }
+program tanonfunc52;
+
+{$mode fpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TFunc = function(aArg1, aArg2: LongInt): LongInt;
+
+var
+  f: TFunc;
+begin
+  f := function(aArg1, aArg2: LongInt) : LongInt
+       begin
+       end;
+end.

tests/test/tanonfunc53.pp

@@ -0,0 +1,28 @@
+{ for consistency with the behavior of operators function result renaming can
+  be used on anonymous functions in Result modes as well }
+
+program tanonfunc53;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TFunc = function(aArg1, aArg2: LongInt): LongInt;
+
+var
+  f: TFunc;
+begin
+  f := function(aArg1, aArg2: LongInt) Res : LongInt
+       begin
+         Res := aArg1 + aArg2;
+       end;
+  if f(2, 3) <> 5 then
+    Halt(1);
+
+  f := function(aArg1, aArg2: LongInt) Res : LongInt
+       begin
+         Result := aArg1 - aArg2;
+       end;
+  if f(7, 4) <> 3 then
+    Halt(2);
+end.

tests/test/tanonfunc54.pp

@@ -0,0 +1,13 @@
+{ %FAIL }
+
+{ an anonymous function by itself isn't a valid expression or statement }
+
+program tanonfunc54;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+begin
+  procedure begin end;
+end.
+

tests/test/tanonfunc55.pp

@@ -0,0 +1,17 @@
+{ %RECOMPILE }
+{ %NORUN }
+
+program tanonfunc55;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+uses
+  uanonfunc55;
+
+var
+  f: specialize TFunc<LongInt>;
+begin
+  f := specialize Foo<LongInt>;
+end.
+

tests/test/tanonfunc56.pp

@@ -0,0 +1,120 @@
+program tanonfunc56;
+
+{$mode objfpc}{$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;
+    function Test1(aArg: TTestMethod): LongInt;
+    function Test1(aArg: TTestNested): LongInt;
+
+    function Test2(aArg: TTestProc): LongInt;
+    function Test2(aArg: TTestMethod): LongInt;
+    function Test2(aArg: TTestProcRef): LongInt;
+
+    function Test3(aArg: TTestProc): LongInt;
+    function Test3(aArg: TTestMethod): LongInt;
+    function Test3(aArg: TTestProcRef): LongInt;
+    function Test3(aArg: TTestNested): LongInt;
+
+    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.

tests/test/tanonfunc57.pp

@@ -0,0 +1,24 @@
+{ %CPU=i8086 }
+
+program tanonfunc57;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+
+type
+  TFarFunc = function: LongInt; far;
+  TNearFunc = function: LongInt; near;
+
+var
+  f: TFarFunc;
+  n: TNearFunc;
+begin
+  f := function: LongInt far begin Result := 42; end;
+  n := function: LongInt near begin Result := 21; end;
+
+  if f() <> 42 then
+    Halt(1);
+  if n() <> 21 then
+    Halt(2);
+end.
+

tests/test/tanonfunc58.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+{ %CPU=i8086 }
+
+program tanonfunc58;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+
+type
+  TFarFunc = function: LongInt; far;
+
+var
+  f: TFarFunc;
+begin
+  f := function: LongInt near begin Result := 42; end;
+end.
+

tests/test/tanonfunc59.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+{ %CPU=i8086 }
+
+program tanonfunc59;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+
+type
+  TNearFunc = function: LongInt; near;
+
+var
+  f: TNearFunc;
+begin
+  f := function: LongInt far begin Result := 42; end;
+end.
+

tests/test/tanonfunc6.pp

@@ -0,0 +1,68 @@
+{ anonymous functions that capture nothing or Self can be assigned to method
+  variables }
+
+program tanonfunc6;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+
+type
+  TTestMethod = function(aArg: LongInt): LongInt of object;
+
+  TTest = class
+    f: LongInt;
+    function Func: LongInt;
+    procedure Test;
+    property p1: LongInt read f;
+    property p2: LongInt read Func;
+  end;
+
+procedure TTest.Test;
+var
+  tm: TTestMethod;
+begin
+  tm := function(aArg: LongInt): LongInt begin Result := aArg + 5; end;
+  if tm(37) <> 42 then
+    Halt(2);
+
+  f := 2;
+  tm := function(aArg: LongInt): LongInt begin Result := f * aArg; end;
+  if tm(21) <> 42 then
+    Halt(3);
+
+  f := 3;
+  tm := function(aArg: LongInt): LongInt begin Result := p1 * aArg; end;
+  if tm(4) <> 12 then
+    Halt(4);
+
+  f := 4;
+  tm := function(aArg: LongInt): LongInt begin Result := Func * aArg; end;
+  if tm(5) <> 20 then
+    Halt(5);
+
+  f := 5;
+  tm := function(aArg: LongInt): LongInt begin Result := p2 * aArg; end;
+  if tm(3) <> 15 then
+    Halt(6);
+end;
+
+function TTest.Func: LongInt;
+begin
+  Result := f;
+end;
+
+var
+  t: TTest;
+  tm: TTestMethod;
+begin
+  tm := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tm(2) <> 4 then
+    Halt(1);
+
+  t := TTest.Create;
+  try
+    t.Test;
+  finally
+    t.Free;
+  end;
+end.

tests/test/tanonfunc7.pp

@@ -0,0 +1,86 @@
+{ any anonymous function can be assigned to a nested procedure variable }
+
+program tanonfunc7;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch nestedprocvars}
+
+type
+  TTestFunc = function(aArg: LongInt): LongInt is nested;
+
+type
+  TTest = class
+    f: LongInt;
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+var
+  tf: TTestFunc;
+  i: LongInt;
+begin
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tf(2) <> 4 then
+    Halt(5);
+
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * f; end;
+
+  f := 3;
+  if tf(2) <> 6 then
+    Halt(6);
+
+  f := 4;
+  if tf(2) <> 8 then
+    Halt(7);
+
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * (f + i); end;
+
+  f := 4;
+  i := 1;
+
+  if tf(2) <> 10 then
+    Halt(8);
+
+  f := 5;
+  i := 1;
+
+  if tf(2) <> 12 then
+    Halt(9);
+
+  f := 5;
+  i := 2;
+
+  if tf(2) <> 14 then
+    Halt(10);
+end;
+
+procedure Test;
+var
+  tf: TTestFunc;
+  i: LongInt;
+begin
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tf(2) <> 4 then
+    Halt(2);
+
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * i; end;
+
+  i := 3;
+  if tf(2) <> 6 then
+    Halt(3);
+
+  i := 4;
+  if tf(2) <> 8 then
+    Halt(4);
+end;
+
+var
+  tf: TTestFunc;
+begin
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tf(1) <> 2 then
+    Halt(1);
+
+  Test;
+end.

tests/test/tanonfunc8.pp

@@ -0,0 +1,86 @@
+{ any anonymous function can be assigned to a nested procedure variable }
+
+program tanonfunc8;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch nestedprocvars}
+
+type
+  TTestFunc = function(aArg: LongInt): LongInt is nested;
+
+type
+  TTest = class
+    f: LongInt;
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+var
+  tf: TTestFunc;
+  i: LongInt;
+begin
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tf(2) <> 4 then
+    Halt(5);
+
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * f; end;
+
+  f := 3;
+  if tf(2) <> 6 then
+    Halt(6);
+
+  f := 4;
+  if tf(2) <> 8 then
+    Halt(7);
+
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * (f + i); end;
+
+  f := 4;
+  i := 1;
+
+  if tf(2) <> 10 then
+    Halt(8);
+
+  f := 5;
+  i := 1;
+
+  if tf(2) <> 12 then
+    Halt(9);
+
+  f := 5;
+  i := 2;
+
+  if tf(2) <> 14 then
+    Halt(10);
+end;
+
+procedure Test;
+var
+  tf: TTestFunc;
+  i: LongInt;
+begin
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tf(2) <> 4 then
+    Halt(2);
+
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * i; end;
+
+  i := 3;
+  if tf(2) <> 6 then
+    Halt(3);
+
+  i := 4;
+  if tf(2) <> 8 then
+    Halt(4);
+end;
+
+var
+  tf: TTestFunc;
+begin
+  tf := function(aArg: LongInt): LongInt begin Result := aArg * 2; end;
+  if tf(1) <> 2 then
+    Halt(1);
+
+  Test;
+end.

tests/test/tanonfunc9.pp

@@ -0,0 +1,28 @@
+{ %FAIL }
+
+{ an anonymous function referencing Self can not be assigned to a procedure
+  variable }
+
+program tanonfunc9;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+
+type
+  TTestFunc = function: LongInt;
+
+  TTest = class
+    f: LongInt;
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+var
+  tf: TTestFunc;
+begin
+  tf := function: LongInt begin Result := f; end;
+end;
+
+begin
+
+end.

tests/test/tblock4.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+{ %TARGET=darwin,iphonesim,ios }
+
+{ a C-block may not reference itself }
+
+program tblock4;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+
+type
+  TBlock = reference to function(l: longint): TBlock; cdecl; cblock;
+
+begin
+end.

tests/test/tblock5.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+{ %TARGET=darwin,iphonesim,ios }
+
+{ a C-block may not reference itself }
+
+program tblock5;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+{$modeswitch functionreferences}
+
+type
+  TBlock = reference to function(l: TBlock): LongInt; cdecl; cblock;
+
+begin
+end.

tests/test/tblock6.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+{ %TARGET=darwin,iphonesim,ios }
+
+{ a C-block may not reference itself }
+
+program tblock6;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+{$modeswitch functionreferences}
+
+type
+  TBlock = reference to function(l: specialize TArray<TBlock>): LongInt; cdecl; cblock;
+
+begin
+end.

tests/test/tblock7.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+{ %TARGET=darwin,iphonesim,ios }
+
+{ a C-block may not reference itself }
+
+program tblock7;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+{$modeswitch functionreferences}
+
+type
+  TBlock = reference to function(l: LongInt): specialize TArray<TBlock>; cdecl; cblock;
+
+begin
+end.

tests/test/tblock8.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+{ %OS=darwin,iphonesim,ios}
+
+program tblock8;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+{$modeswitch functionreferences-}
+
+type
+  TBlock = reference to procedure(aArg: LongInt); cdecl;
+
+begin
+end.

tests/test/tblock9.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+{ %OS=darwin,iphonesim,ios}
+
+program tblock9;
+
+{$mode objfpc}
+{$modeswitch cblocks}
+{$modeswitch functionreferences-}
+
+var
+  block: reference to procedure(aArg: LongInt); cdecl;
+
+begin
+end.

tests/test/tfuncref1.pp

@@ -0,0 +1,84 @@
+{ %OPT=-gh }
+
+program tfuncref1;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+type
+  TTest1 = reference to procedure;
+  TTest2 = reference to function: LongInt;
+  TTest3 = reference to function(aArg: String): LongInt;
+  generic TTest4<T> = reference to procedure(aArg: T);
+
+  TImpl1 = class(TInterfacedObject, TTest1)
+    procedure Invoke;
+  end;
+
+  TImpl2 = class(TInterfacedObject, TTest2)
+    function Invoke: LongInt;
+  end;
+
+  TImpl3 = class(TInterfacedObject, TTest3)
+    function Invoke(aArg: String): LongInt;
+  end;
+
+  TImpl4 = class(TInterfacedObject, specialize TTest4<LongInt>)
+    procedure Invoke(aArg: LongInt);
+  end;
+
+var
+  invokeid: LongInt = 0;
+
+procedure TImpl1.Invoke;
+begin
+  invokeid := 1;
+end;
+
+function TImpl2.Invoke: LongInt;
+begin
+  invokeid := 2;
+  Result := 21;
+end;
+
+function TImpl3.Invoke(aArg: String): LongInt;
+begin
+  invokeid := 3;
+  Result := 42;
+end;
+
+procedure TImpl4.Invoke(aArg: LongInt);
+begin
+  invokeid := 4;
+end;
+
+var
+  impl1: TTest1;
+  impl2: TTest2;
+  impl3: TTest3;
+  impl4: specialize TTest4<LongInt>;
+begin
+  {$if declared(HaltOnNotReleased)}
+  HaltOnNotReleased:=True;
+  {$endif}
+  invokeid := 0;
+  impl1 := TImpl1.Create;
+  impl1();
+  if invokeid <> 1 then
+    Halt(1);
+  invokeid := 0;
+  impl2 := TImpl2.Create;
+  impl2();
+  if invokeid <> 2 then
+    Halt(2);
+  invokeid := 0;
+  impl3 := TImpl3.Create;
+  impl3('Foobar');
+  if invokeid <> 3 then
+    Halt(3);
+  invokeid := 0;
+  impl4 := TImpl4.Create;
+  impl4(42);
+  if invokeid <> 4 then
+    Halt(4);
+end.

tests/test/tfuncref10.pp

@@ -0,0 +1,52 @@
+{ %NORUN }
+
+{ interfaces that descend from function references can be used as function
+  references as well including overloads and such }
+program tfuncref10;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+var
+  l: LongInt;
+  s: String;
+  tf: TTestFunc;
+  if1: ITestFunc1;
+  if2: ITestFunc2;
+  if3: ITestFunc3;
+  if4: ITestFunc4;
+  if5: ITestFunc5;
+  if6: ITestFunc6;
+  if7: ITestFunc7;
+  if8: ITestFunc8;
+  if9: ITestFunc9;
+begin
+  l := tf();
+  { these two still call the Invoke of TTestFunc }
+  l := if1();
+  l := if2();
+  { here only the String function is available }
+  s := if3();
+  //l := if3();
+  { in principle both are available, but since we can't overload based on
+    result type only the second one can be called }
+  s := if4();
+  //l := if4();
+  { only the overload with the parameter is available here }
+  //l := if5();
+  l := if5(42);
+  { both overloads can be used }
+  l := if6();
+  l := if6(42);
+  { if it doesn't inherit from a function reference it can't be called directly }
+  //l := if7();
+  { ObjFPC mode requires parenthesis, so calling other methods on the interface
+    can be done directly }
+  l := if8.Foobar;
+  { procedures and functions can be overloaded as well }
+  l := if9();
+  if9(42);
+end.

tests/test/tfuncref11.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tfuncref11;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+var
+  l: LongInt;
+  i: ITestFunc3;
+begin
+  { only the String Invoke is available }
+  l := i();
+end.

tests/test/tfuncref12.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+program tfuncref12;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+var
+  l: LongInt;
+  i: ITestFunc4;
+begin
+  { both are available, but since overloads by result type are not possible
+    only the last one is available }
+  l := i();
+end.

tests/test/tfuncref13.pp

@@ -0,0 +1,23 @@
+{ %NORUN }
+{ .%FAIL }
+{ Note: according to tests with Delphi this test *should* be FAIL, because if a
+        method in a class does not have the overload directive it should hide
+        the same methods introduced by a parent class, but since at least 2010
+        we apply the overload flag to all methods of the same name if one of the
+        parents had this flag as well }
+
+program tfuncref13;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+var
+  l: LongInt;
+  i: ITestFunc5;
+begin
+  { only the overload with the parameter is available }
+  l := i();
+end.

tests/test/tfuncref14.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+program tfuncref14;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+var
+  l: LongInt;
+  i: ITestFunc7;
+begin
+  { if it doesn't inherit from a function reference then it can't be called
+    directly }
+  l := i();
+end.

tests/test/tfuncref15.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+program tfuncref15;
+
+{$mode delphi}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+var
+  l: LongInt;
+  i: ITestFunc8;
+begin
+  { Delphi mode calls ITestFunc8.Invoke and thus would try to apply Foobar to
+    the result type LongInt }
+  l := if8.Foobar;
+end.

tests/test/tfuncref16.pp

@@ -0,0 +1,42 @@
+program tfuncref16;
+
+{$mode delphi}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  ufuncref10;
+
+type
+  TTestFunc8 = class(TInterfacedObject, ITestFunc8)
+    function Invoke: LongInt;
+    function Foobar: LongInt;
+  end;
+
+  TLongIntHelper = record helper for LongInt
+    function Foobar: LongInt;
+  end;
+
+function TTestFunc8.Invoke: LongInt;
+begin
+  Result := 21;
+end;
+
+function TTestFunc8.Foobar: LongInt;
+begin
+  Result := 42;
+end;
+
+function TLongIntHelper.Foobar: LongInt;
+begin
+  Result := 2;
+end;
+
+var
+  i: ITestFunc8;
+begin
+  i := TTestFunc8.Create;
+  { Delphi mode calls ITestFunc8.Invoke and thus applies Foobar to the result
+    type LongInt }
+  if i.Foobar <> 2 then
+    Halt(1);
+end.

tests/test/tfuncref17.pp

@@ -0,0 +1,43 @@
+program tfuncref17;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+{$modeswitch typehelpers}
+
+uses
+  ufuncref10;
+
+type
+  TTestFunc8 = class(TInterfacedObject, ITestFunc8)
+    function Invoke: LongInt;
+    function Foobar: LongInt;
+  end;
+
+  TLongIntHelper = type helper for LongInt
+    function Foobar: LongInt;
+  end;
+
+function TTestFunc8.Invoke: LongInt;
+begin
+  Result := 21;
+end;
+
+function TTestFunc8.Foobar: LongInt;
+begin
+  Result := 42;
+end;
+
+function TLongIntHelper.Foobar: LongInt;
+begin
+  Result := 2;
+end;
+
+var
+  i: ITestFunc8;
+begin
+  i := TTestFunc8.Create;
+  { non-Delphi modes don't calls ITestFunc8.Invoke and thus execute Foobar
+    of ITestFunc8 }
+  if i.Foobar <> 42 then
+    Halt(1);
+end.

tests/test/tfuncref18.pp

@@ -0,0 +1,16 @@
+{ %NORUN }
+
+program tfuncref18;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+type
+  TTest1 = reference to function: TTest1;
+  TTest2 = reference to procedure(aArg: TTest2);
+  { this needs support for specialize defs to work correctly }
+  //TTest3 = reference to function(aArg: specialize TArray<TTest3>): specialize TArray<TTest3>;
+
+begin
+
+end.

tests/test/tfuncref19.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+{ it's not allowed to call IUnknown methods on a function reference directly }
+program tfuncref19;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+type
+  TProc = reference to procedure(aArg: LongInt);
+
+var
+  p: TProc;
+begin
+  p._AddRef;
+end.

tests/test/tfuncref2.pp

@@ -0,0 +1,34 @@
+{ %OPT=-gh }
+
+{ function reference with compatible signatures can be assigned to each other }
+program tfuncref2;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+type
+  TFunc1 = reference to function(aArg: LongInt): String;
+  TFunc2 = reference to function(aArg: LongInt): String;
+
+  TTest = class(TInterfacedObject, TFunc1)
+    function Invoke(aArg: LongInt): String;
+  end;
+
+function TTest.Invoke(aArg: LongInt): String;
+begin
+  Str(aArg, Result);
+end;
+
+var
+  f1: TFunc1;
+  f2: TFunc2;
+begin
+  {$if declared(HaltOnNotReleased)}
+  HaltOnNotReleased:=True;
+  {$endif}
+  f1 := TTest.Create;
+  f2 := f1;
+  f1 := Nil;
+  if f2(42) <> '42' then
+    Halt(1);
+end.

tests/test/tfuncref20.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+{ it's not allowed to call IUnknown methods on a function reference directly }
+program tfuncref20;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+type
+  TProc = reference to procedure(aArg: LongInt);
+
+var
+  p: TProc;
+begin
+  p._AddRef;
+end.

tests/test/tfuncref21.pp

@@ -0,0 +1,20 @@
+{ %NORUN }
+
+{ a function reference can be cast to IUnknown in non-Delphi modes to call its
+  management functions }
+program tfuncref21;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+type
+  TProc = reference to procedure(aArg: LongInt);
+  TProc2 = reference to procedure;
+
+var
+  p: TProc;
+  p2: TProc2;
+begin
+  IUnknown(p)._AddRef;
+  IUnknown(p2)._AddRef;
+end.

tests/test/tfuncref22.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{ a function reference can't be cast to IUnknown in mode Delphi to call its
+  management functions }
+program tfuncref22;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+type
+  TProc = reference to procedure(aArg: LongInt);
+
+var
+  p: TProc;
+begin
+  IUnknown(p)._AddRef;
+end.

tests/test/tfuncref23.pp

@@ -0,0 +1,77 @@
+program tfuncref23;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+
+type
+  TLongIntFunc = reference to function(aArg: LongInt): LongInt;
+
+  TTest = class
+    i: LongInt;
+    function TestCaptureSelf: TLongIntFunc;
+  end;
+
+
+function TestNoCapture: TLongIntFunc;
+
+  function Foobar(aArg: LongInt): LongInt;
+  begin
+    Result := 42 * aArg;
+  end;
+
+begin
+  Result := @Foobar;
+end;
+
+function TestCaptureLocal: TLongIntFunc;
+var
+  i: LongInt;
+
+  function Foobar(aArg: LongInt): LongInt;
+  begin
+    Result := i * aArg;
+  end;
+
+begin
+  i := 0;
+  Result := @Foobar;
+  i := 21;
+end;
+
+function TTest.TestCaptureSelf: TLongIntFunc;
+
+  function Foobar(aArg: LongInt): LongInt;
+  begin
+    Result := i * aArg;
+  end;
+
+begin
+  i := 0;
+  Result := @Foobar;
+  i := 84;
+end;
+
+var
+  t: TTest;
+  f: TLongIntFunc;
+begin
+  f := TestNoCapture();
+  if f(2) <> 84 then
+    Halt(1);
+
+  f := TestCaptureLocal();
+  if f(2) <> 42 then
+    Halt(2);
+
+  t := TTest.Create;
+  try
+    f := t.TestCaptureSelf;
+    if f(2) <> 168 then
+      Halt(3);
+  finally
+    t.Free;
+  end;
+
+  Writeln('ok');
+end.

tests/test/tfuncref24.pp

@@ -0,0 +1,77 @@
+program tfuncref24;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+
+type
+  TLongIntFunc = reference to function(aArg: LongInt): LongInt;
+
+  TTest = class
+    i: LongInt;
+    function TestCaptureSelf: TLongIntFunc;
+  end;
+
+
+function TestNoCapture: TLongIntFunc;
+
+  function Foobar(aArg: LongInt): LongInt;
+  begin
+    Result := 42 * aArg;
+  end;
+
+begin
+  Result := Foobar;
+end;
+
+function TestCaptureLocal: TLongIntFunc;
+var
+  i: LongInt;
+
+  function Foobar(aArg: LongInt): LongInt;
+  begin
+    Result := i * aArg;
+  end;
+
+begin
+  i := 0;
+  Result := Foobar;
+  i := 21;
+end;
+
+function TTest.TestCaptureSelf: TLongIntFunc;
+
+  function Foobar(aArg: LongInt): LongInt;
+  begin
+    Result := i * aArg;
+  end;
+
+begin
+  i := 0;
+  Result := Foobar;
+  i := 84;
+end;
+
+var
+  t: TTest;
+  f: TLongIntFunc;
+begin
+  f := TestNoCapture();
+  if f(2) <> 84 then
+    Halt(1);
+
+  f := TestCaptureLocal();
+  if f(2) <> 42 then
+    Halt(2);
+
+  t := TTest.Create;
+  try
+    f := t.TestCaptureSelf;
+    if f(2) <> 168 then
+      Halt(3);
+  finally
+    t.Free;
+  end;
+
+  Writeln('ok');
+end.

tests/test/tfuncref25.pp

@@ -0,0 +1,66 @@
+program tfuncref25;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+type
+  TTestFuncRef = reference to function: LongInt;
+  TTestFunc = function: LongInt;
+  TTestMethod = function: LongInt of object;
+
+type
+  TTest = class
+    f: LongInt;
+    function Test: LongInt;
+  end;
+
+function TTest.Test: LongInt;
+begin
+  Result := f;
+end;
+
+function Test1: LongInt;
+begin
+  Result := 1;
+end;
+
+function Test2: LongInt;
+begin
+  Result := 2;
+end;
+
+function GetFunc: TTestFuncRef;
+var
+  func: TTestFunc;
+begin
+  func := @Test1;
+  Result := func;
+  func := @Test2;
+end;
+
+function GetMethod(t1, t2: TTest): TTestFuncRef;
+var
+  method: TTestMethod;
+begin
+  method := @t1.Test;
+  Result := method;
+  method := @t2.Test;
+end;
+
+var
+  f: TTestFuncRef;
+  t1, t2: TTest;
+begin
+  f := GetFunc;
+  if f() <> 1 then
+    Halt(1);
+  t1 := TTest.Create;
+  t1.f := 2;
+  t2 := TTest.Create;
+  t2.f := 3;
+  f := GetMethod(t1, t2);
+  if f() <> 2 then
+    Halt(2);
+  t1.Free;
+  t2.Free;
+end.

tests/test/tfuncref26.pp

@@ -0,0 +1,77 @@
+program tfuncref26;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+type
+  TTestObject = class(TInterfacedObject, IInterface)
+    destructor Destroy; override;
+  end;
+
+  TTestFunc = reference to procedure;
+
+var
+  destroyed: Boolean;
+
+destructor TTestObject.Destroy;
+begin
+  destroyed := True;
+  inherited;
+end;
+
+{ use out parameter to avoid the usage of a temp }
+procedure DoTest(out res: TTestFunc);
+var
+  intf: IInterface;
+
+  procedure TestSub;
+  begin
+    intf._AddRef;
+    intf._Release;
+  end;
+
+begin
+  intf := TTestObject.Create;
+  res := @TestSub;
+end;
+
+procedure DoTest2(out res: TTestFunc);
+var
+  intf: IInterface;
+
+  procedure TestSub(out res: TTestFunc);
+  begin
+    res := procedure
+           begin
+             intf._AddRef;
+             intf._Release;
+           end;
+  end;
+
+begin
+  intf := TTestObject.Create;
+  TestSub(res);
+end;
+
+var
+  f: TTestFunc;
+begin
+  DoTest(f);
+  if destroyed then
+    Halt(1);
+  f();
+  f := Nil;
+  if not destroyed then
+    Halt(2);
+
+  destroyed := False;
+
+  DoTest2(f);
+  if destroyed then
+    Halt(3);
+  f();
+  f := Nil;
+  if not destroyed then
+    Halt(4);
+end.

tests/test/tfuncref27.pp

@@ -0,0 +1,23 @@
+{ %FAIL }
+
+program tfuncref27;
+
+{$mode objfpc}{$H+}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+type
+  TTestFunc = reference to procedure;
+
+function DoTest: TTestFunc;
+
+  function TestSub: TTestFunc;
+  begin
+  end;
+
+begin
+  Result := @TestSub;
+end;
+
+begin
+end.

tests/test/tfuncref28.pp

@@ -0,0 +1,37 @@
+program tfuncref28;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+uses
+  TypInfo;
+
+type
+  {$M+}
+  TFunc = reference to function: LongInt;
+  {$M-}
+  TFunc2 = reference to function: LongInt;
+
+var
+  ti: PTypeInfo;
+  td: PTypeData;
+  intf: PInterfaceData;
+  methods: PIntfMethodTable;
+begin
+  ti := PTypeInfo(TypeInfo(TFunc));
+  td := GetTypeData(ti);
+  intf := PInterfaceData(td);
+  methods := intf^.MethodTable;
+  if methods^.Count <> 1 then
+    Halt(1);
+  if methods^.RTTICount <> 1 then
+    Halt(2);
+  ti := PTypeInfo(TypeInfo(TFunc2));
+  td := GetTypeData(ti);
+  intf := PInterfaceData(td);
+  methods := intf^.MethodTable;
+  if methods^.Count <> 1 then
+    Halt(3);
+  if methods^.RTTICount <> High(Word) then
+    Halt(4);
+end.

tests/test/tfuncref29.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+
+program tfuncref29;
+
+{$modeswitch functionreferences}
+
+type
+  reference = record
+  end;
+  someref = reference;
+
+begin
+
+end.

tests/test/tfuncref3.pp

@@ -0,0 +1,52 @@
+{ %NORUN }
+
+{ function references can also be declared as anonymous types }
+program tfuncref3;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+var
+  Proc1: reference to procedure;
+
+type
+  TTestRecord = record
+    Field1: reference to procedure;
+  end;
+
+  TTestObject = class
+    Field1: reference to procedure;
+  end;
+
+var
+  testvar,
+  testuse: LongInt;
+
+procedure TestProc;
+begin
+  testvar := testuse;
+end;
+
+var
+  r: TTestRecord;
+  o: TTestObject;
+begin
+  Proc1 := @TestProc;
+  testuse := 42;
+  Proc1();
+  if testvar <> 42 then
+    Halt(1);
+
+  r.Field1 := @TestProc;
+  testuse := 21;
+  r.Field1();
+  if testvar <> 21 then
+    Halt(2);
+
+  o := TTestObject.Create;
+  o.Field1 := @TestProc;
+  testuse := 84;
+  o.Field1();
+  if testvar <> 84 then
+    Halt(3);
+end.

tests/test/tfuncref30.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+program tfuncref30;
+
+{$modeswitch functionreferences}
+
+type
+  reference = record
+  end;
+
+var
+  somevar: reference;
+
+begin
+
+end.

tests/test/tfuncref31.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+
+program tfuncref31;
+
+{$modeswitch functionreferences}
+
+type
+  reference = record
+  end;
+
+  someref = &reference;
+
+var
+  somevar: &reference;
+
+begin
+
+end.

tests/test/tfuncref32.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+
+program tfuncref32;
+
+{$modeswitch functionreferences-}
+
+type
+  reference = record
+  end;
+
+  someref = reference;
+
+var
+  somevar: reference;
+
+begin
+
+end.

tests/test/tfuncref4.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+
+{ anonymous reference function types as function arguments are not allowed }
+program tfuncref4;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+procedure Test(aArg: reference to procedure);
+begin
+end;
+
+begin
+end.

tests/test/tfuncref5.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+{ normal procedure variable directives can be used on function references }
+program tfuncref5;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+type
+  TProc1 = reference to procedure cdecl;
+  TProc2 = reference to procedure; cdecl;
+  TProc3 = reference to procedure; [cdecl];
+
+  TFunc1 = reference to function: LongInt cdecl;
+  TFunc2 = reference to function: LongInt; cdecl;
+  TFunc3 = reference to function: LongInt; [cdecl];
+
+var
+  Proc1: reference to procedure cdecl;
+  Proc2: reference to procedure; cdecl;
+  //Proc3: reference to procedure; [cdecl];
+
+  Func1: reference to function: LongInt cdecl;
+  Func2: reference to function: LongInt; cdecl;
+  //Func3: reference to function: LongInt; [cdecl];
+
+const
+  CProc1: reference to procedure cdecl = Nil;
+  CProc2: reference to procedure; cdecl = Nil;
+  //CProc3: reference to procedure; [cdecl] = Nil;
+
+  CFunc1: reference to function: LongInt cdecl = Nil;
+  CFunc2: reference to function: LongInt; cdecl = Nil;
+  //CFunc3: reference to function: LongInt; [cdecl] = Nil;
+
+begin
+
+end.

tests/test/tfuncref6.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ function reference with different signatures can't be assigned to each other }
+program tfuncref6;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+type
+  TFunc1 = reference to function(aArg: LongInt): String;
+  TFunc2 = reference to function(aArg: LongInt): LongInt;
+
+var
+  f1: TFunc1;
+  f2: TFunc2;
+begin
+  f2 := Nil;
+  f1 := f2;
+end.

tests/test/tfuncref7.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ function reference with different signatures can't be assigned to each other }
+program tfuncref7;
+
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+
+type
+  TFunc1 = reference to function(aArg: LongInt): String; cdecl;
+  TFunc2 = reference to function(aArg: LongInt): String; stdcall;
+
+var
+  f1: TFunc1;
+  f2: TFunc2;
+begin
+  f2 := Nil;
+  f1 := f2;
+end.

tests/test/tfuncref8.pp

@@ -0,0 +1,61 @@
+program tfuncref8;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+{ test assigning global procedures, methods, and object methods to function references }
+
+type
+  TProc = reference to procedure;
+
+procedure CallProc(AProc: TProc);
+begin
+  AProc();
+end;
+
+type
+  TTest = class
+    class procedure ClassMethod;
+    procedure InstanceMethod;
+  end;
+
+var
+  Acc: Integer;
+
+procedure GlobalProc;
+begin
+  Inc(Acc);
+end;
+
+class procedure TTest.ClassMethod;
+begin
+  Inc(Acc, 10);
+end;
+
+procedure TTest.InstanceMethod;
+begin
+  Inc(Acc, 100);
+end;
+
+var
+  Proc: TProc;
+  Obj: TTest;
+begin
+  Proc := @GlobalProc;
+  Proc();
+  CallProc(@GlobalProc);
+
+  Proc := @TTest.ClassMethod;
+  Proc();
+  CallProc(@TTest.ClassMethod);
+
+  Obj := TTest.Create;
+  Proc := @Obj.InstanceMethod;
+  Proc();
+  CallProc(@Obj.InstanceMethod);
+  Obj.Free;
+
+  if Acc <> 222 then
+    halt(Acc);
+end.
+

tests/test/tfuncref9.pp

@@ -0,0 +1,61 @@
+program tfuncref9;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+{ test assigning global procedures, methods, and object methods to function references }
+
+type
+  TProc = reference to procedure;
+
+procedure CallProc(AProc: TProc);
+begin
+  AProc();
+end;
+
+type
+  TTest = class
+    class procedure ClassMethod;
+    procedure InstanceMethod;
+  end;
+
+var
+  Acc: Integer;
+
+procedure GlobalProc;
+begin
+  Inc(Acc);
+end;
+
+class procedure TTest.ClassMethod;
+begin
+  Inc(Acc, 10);
+end;
+
+procedure TTest.InstanceMethod;
+begin
+  Inc(Acc, 100);
+end;
+
+var
+  Proc: TProc;
+  Obj: TTest;
+begin
+  Proc := GlobalProc;
+  Proc();
+  CallProc(GlobalProc);
+
+  Proc := TTest.ClassMethod;
+  Proc();
+  CallProc(TTest.ClassMethod);
+
+  Obj := TTest.Create;
+  Proc := Obj.InstanceMethod;
+  Proc();
+  CallProc(Obj.InstanceMethod);
+  Obj.Free;
+
+  if Acc <> 222 then
+    halt(Acc);
+end.
+

tests/test/uanonfunc20.pp

@@ -0,0 +1,21 @@
+unit uanonfunc20;
+
+{$mode objfpc}
+
+interface
+
+type
+  tbase = class
+  protected
+    function x: longint;
+  end;
+
+implementation
+
+function tbase.x: longint;
+begin
+  result := 123;
+end;
+
+end.
+

tests/test/uanonfunc21.pp

@@ -0,0 +1,21 @@
+unit uanonfunc21;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+interface
+
+type
+  tproc = reference to procedure;
+
+procedure bar(p: tproc);
+
+implementation
+
+procedure bar(p: tproc);
+begin
+  p();
+end;
+
+end.
+

tests/test/uanonfunc22.pp

@@ -0,0 +1,35 @@
+unit uanonfunc22;
+
+{$mode objfpc}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+interface
+
+type
+  tproc = reference to procedure;
+
+procedure foo;
+procedure bar(p: tproc);
+
+implementation
+
+procedure foo;
+var
+  i: Integer;
+begin
+  bar(procedure
+    begin
+      i := 123;
+    end);
+  if i <> 123 then
+    halt(1);
+end;
+
+procedure bar(p: tproc);
+begin
+  p();
+end;
+
+end.
+