Explorar el Código

* fix #39898: when a loadnode is captured ensure that its nf_load_procvar flag is applied to the subscript node as well
+ added tests

Sven/Sarah Barth hace 2 años
padre
commit
4f9acc10f0

+ 4 - 0
compiler/procdefutil.pas

@@ -1421,6 +1421,7 @@ implementation
       mapping : pconvert_mapping;
       i : longint;
       old_filepos : tfileposinfo;
+      loadprocvar : boolean;
     begin
       result:=fen_true;
       if n.nodetype<>loadn then
@@ -1432,8 +1433,11 @@ implementation
             continue;
           old_filepos:=current_filepos;
           current_filepos:=n.fileinfo;
+          loadprocvar:=nf_load_procvar in n.flags;
           n.free;
           n:=csubscriptnode.create(mapping^.newsym,mapping^.selfnode.getcopy);
+          if loadprocvar then
+            include(n.flags,nf_load_procvar);
           typecheckpass(n);
           current_filepos:=old_filepos;
           break;

+ 57 - 0
tests/test/tanonfunc61.pp

@@ -0,0 +1,57 @@
+program tanonfunc61;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test calling into overloaded routines and creating anonymous methods in them. 
+
+  Same as tanonfunc23 but with mode delphi
+}
+
+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.
+

+ 58 - 0
tests/test/tanonfunc62.pp

@@ -0,0 +1,58 @@
+program tanonfunc62;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test calling into overloaded routines and creating anonymous methods (with no
+  params) in them 
+
+  similar to tanonfunc23 and tanonfunc61 but mode Delphi and no params in tcharproc
+}
+
+type
+  tproc = reference to procedure;
+  tcharproc = reference to procedure;
+  tintproc = reference to procedure(i: longint);
+
+procedure baz(p: tproc);
+begin
+  p();
+end;
+
+procedure bar(p: tcharproc); overload;
+begin
+  baz(procedure
+    begin
+      p();
+    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.
+

+ 56 - 0
tests/test/tanonfunc63.pp

@@ -0,0 +1,56 @@
+program tanonfunc63;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test anonymous methods with extremely long symbol names 
+
+  similar to tanonfunc24 but mode delphi
+}
+
+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.

+ 49 - 0
tests/test/tanonfunc64.pp

@@ -0,0 +1,49 @@
+{ %target=darwin,iphonesim }
+{ %skipcpu=powerpc,powerpc64 }
+
+program tanonfunc64;
+
+{$mode delphi}
+{$modeswitch cblocks}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test using anonymous functions and C blocks together 
+
+  same as tanonfunc26 but mode delphi
+}
+
+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.

+ 33 - 0
tests/test/tanonfunc65.pp

@@ -0,0 +1,33 @@
+program tanonfunc65;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test generic anonymous method reference 
+
+  same as tanonfunc34 but with mode delphi
+}
+
+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.
+

+ 29 - 0
tests/test/tanonfunc66.pp

@@ -0,0 +1,29 @@
+program tanonfunc66;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test generic local reference declaration 
+
+  same as tanonfunc39 but mode delphi
+}
+
+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.
+

+ 74 - 0
tests/test/tanonfunc67.pp

@@ -0,0 +1,74 @@
+{ %NORUN }
+
+program tanonfunc67;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+{$modeswitch advancedrecords}
+
+{ test advanced generics 
+
+  same as tanonfunc41 but mode delphi
+}
+
+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>;
+// TODO: var 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));
+  // TODO: nameless routines in generics
+end;
+
+var
+  X: M<Integer>{G<Integer>.M};
+  Y: R;
+begin
+  X := C<Integer>.Create;
+  X(42)(777)(1024);
+
+  Y.Foo;
+end.

+ 19 - 0
tests/test/tanonfunc68.pp

@@ -0,0 +1,19 @@
+{ %RECOMPILE }
+{ %NORUN }
+
+program tanonfunc68;
+
+{$mode delphi}{$H+}
+{$modeswitch advancedrecords}
+
+{same as tanonfunc55 but mode delphi}
+
+uses
+  uanonfunc55;
+
+var
+  f: TFunc<LongInt>;
+begin
+  f := Foo<LongInt>;
+end.
+

+ 122 - 0
tests/test/tanonfunc69.pp

@@ -0,0 +1,122 @@
+program tanonfunc69;
+
+{$mode delphi}{$H+}
+{$modeswitch functionreferences}
+{$modeswitch anonymousfunctions}
+{$modeswitch nestedprocvars}
+
+{same as tanonfunc56 but mode delphi}
+
+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.

+ 37 - 0
tests/test/tanonfunc70.pp

@@ -0,0 +1,37 @@
+{ %NORUN }
+
+program tanonfunc70;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{ test calling into overloaded routines and creating anonymous methods in them. 
+
+  Similar to tanonfunc61 but with additonal calls to func ref before and after
+  anonfunc use of func ref.  With func ref inside an anon method, the func
+  references outside the anon method will also error out.
+}
+
+type
+  tproc = reference to procedure;
+  tcharproc = reference to procedure(c: char);
+
+procedure baz(p: tproc);
+begin
+  p();
+end;
+
+procedure bar(p: tcharproc); overload;
+begin
+  p('b');
+  baz(procedure
+    begin
+      p('a');
+    end);
+  p('c');
+end;
+
+begin
+end.
+

+ 86 - 0
tests/test/tfuncref43.pp

@@ -0,0 +1,86 @@
+{ %OPT=-gh }
+
+program tfuncref43;
+
+{$mode delphi}{$H+}
+{$modeswitch functionreferences}
+
+{same as tfuncref1 but with mode delphi}
+
+type
+  TTest1 = reference to procedure;
+  TTest2 = reference to function: LongInt;
+  TTest3 = reference to function(aArg: String): LongInt;
+  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, 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: 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.

+ 40 - 0
tests/test/tfuncref44.pp

@@ -0,0 +1,40 @@
+{ %NORUN }
+
+{ normal procedure variable directives can be used on function references }
+program tfuncref44;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+{same as tfuncref5 but with mode delphi}
+
+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.

+ 65 - 0
tests/test/tfuncref45.pp

@@ -0,0 +1,65 @@
+program tfuncref45;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+{ test assigning global procedures, methods, and object methods to function
+  references 
+
+  same as tfuncref8 but with mode delphi
+}
+
+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.
+

+ 78 - 0
tests/test/tfuncref46.pp

@@ -0,0 +1,78 @@
+program tfuncref46;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+{same as tfuncref23 but with mode delphi}
+
+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.

+ 68 - 0
tests/test/tfuncref47.pp

@@ -0,0 +1,68 @@
+program tfuncref47;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+
+{same as tfuncref25 but with mode delphi}
+
+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.

+ 79 - 0
tests/test/tfuncref48.pp

@@ -0,0 +1,79 @@
+program tfuncref48;
+
+{$mode delphi}{$H+}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+{same as tfuncref26 but with mode delphi}
+
+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.

+ 161 - 0
tests/test/tfuncref49.pp

@@ -0,0 +1,161 @@
+program tfuncref49;
+
+{$mode delphi}
+{$modeswitch functionreferences}
+{$modeswitch nestedprocvars}
+
+{same as tfuncref33 but with mode delphi}
+
+type
+  TProcVar = procedure;
+  TMethodVar = procedure of object;
+  TProcRef = reference to procedure;
+  TNestedVar = procedure is nested;
+
+  TTest = class
+    function Test1(aArg: TProcVar): LongInt; overload;
+    function Test1(aArg: TProcRef): LongInt; overload;
+
+    function Test2(aArg: TMethodVar): LongInt; overload;
+    function Test2(aArg: TProcRef): LongInt; overload;
+
+    function Test3(aArg: TNestedVar): LongInt; overload;
+    function Test3(aArg: TProcRef): LongInt; overload;
+
+    function Test4(aArg: TProcVar): LongInt; overload;
+    function Test4(aArg: TMethodVar): LongInt; overload;
+    function Test4(aArg: TProcRef): LongInt; overload;
+
+    function Test5(aArg: TProcVar): LongInt; overload;
+    function Test5(aArg: TMethodVar): LongInt; overload;
+    function Test5(aArg: TNestedVar): LongInt; overload;
+    function Test5(aArg: TProcRef): LongInt; overload;
+
+    procedure TestMethod;
+
+    procedure DoTest;
+  end;
+
+procedure TestProc;
+begin
+end;
+
+function TTest.Test1(aArg: TProcVar): LongInt;
+begin
+  Result := 1;
+end;
+function TTest.Test1(aArg: TProcRef): LongInt;
+begin
+  Result := 2;
+end;
+function TTest.Test2(aArg: TMethodVar): LongInt;
+begin
+  Result := 3;
+end;
+function TTest.Test2(aArg: TProcRef): LongInt;
+begin
+  Result := 4;
+end;
+function TTest.Test3(aArg: TNestedVar): LongInt;
+begin
+  Result := 5;
+end;
+function TTest.Test3(aArg: TProcRef): LongInt;
+begin
+  Result := 6;
+end;
+function TTest.Test4(aArg: TProcVar): LongInt;
+begin
+  Result := 7;
+end;
+function TTest.Test4(aArg: TMethodVar): LongInt;
+begin
+  Result := 8;
+end;
+function TTest.Test4(aArg: TProcRef): LongInt;
+begin
+  Result := 9;
+end;
+function TTest.Test5(aArg: TProcVar): LongInt;
+begin
+  Result := 10;
+end;
+function TTest.Test5(aArg: TMethodVar): LongInt;
+begin
+  Result := 11;
+end;
+function TTest.Test5(aArg: TNestedVar): LongInt;
+begin
+  Result := 12;
+end;
+function TTest.Test5(aArg: TProcRef): LongInt;
+begin
+  Result := 13;
+end;
+
+procedure TTest.TestMethod;
+begin
+end;
+
+procedure TTest.DoTest;
+
+  procedure NestedProc;
+  begin
+  end;
+
+var
+  f: TProcRef;
+begin
+  if Test1(TestProc) <> 1 then
+    Halt(1);
+  if Test1(TestMethod) <> 2 then
+    Halt(2);
+  if Test1(NestedProc) <> 2 then
+    Halt(3);
+  if Test1(f) <> 2 then
+    Halt(4);
+
+  if Test2(TestProc) <> 4 then
+    Halt(5);
+  if Test2(TestMethod) <> 3 then
+    Halt(6);
+  if Test2(NestedProc) <> 4 then
+    Halt(7);
+  if Test2(f) <> 4 then
+    Halt(8);
+
+  if Test3(TestProc) <> 5 then
+    Halt(9);
+  if Test3(TestMethod) <> 6 then
+    Halt(10);
+  if Test3(NestedProc) <> 5 then
+    Halt(11);
+  if Test3(f) <> 6 then
+    Halt(12);
+
+  if Test4(TestProc) <> 7 then
+    Halt(13);
+  if Test4(TestMethod) <> 8 then
+    Halt(14);
+  if Test4(NestedProc) <> 9 then
+    Halt(15);
+  if Test4(f) <> 9 then
+    Halt(16);
+
+  if Test5(TestProc) <> 10 then
+    Halt(17);
+  if Test5(TestMethod) <> 11 then
+    Halt(18);
+  if Test5(NestedProc) <> 12 then
+    Halt(19);
+  if Test5(f) <> 13 then
+    Halt(20);
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.DoTest;
+  t.Free;
+end.