* when taking the address of a method1 that is specified by subscripting

the result of a objtype.method2 call, ensure that we call method2 with
    objtype as methdpointer rather than the self node of the current routine
    (mantis #24844)

git-svn-id: trunk@27977 -

.gitattributes

@@ -13889,6 +13889,10 @@ tests/webtbs/tw2473.pp svneol=native#text/plain
 tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
+tests/webtbs/tw24844.pp svneol=native#text/plain
+tests/webtbs/tw24844a.pp svneol=native#text/plain
+tests/webtbs/tw24844b.pp svneol=native#text/plain
+tests/webtbs/tw24844c.pp svneol=native#text/plain
 tests/webtbs/tw24848.pp svneol=native#text/pascal
 tests/webtbs/tw24863.pp svneol=native#text/plain
 tests/webtbs/tw24865.pp svneol=native#text/pascal

compiler/pexpr.pas

@@ -1438,6 +1438,15 @@ implementation
                    begin
                      check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
                      consume(_ID);
+                     { in case of @Object.Method1.Method2, we have to call
+                       Method1 -> create a loadvmtaddr node as self instead of
+                       a typen (the typenode would be changed to self of the
+                       current method in case Method1 is a constructor, see
+                       mantis #24844) }
+                     if not(block_type in [bt_type,bt_const_type,bt_var_type]) and
+                        (srsym.typ=procsym) and
+                        (token in [_CARET,_POINT]) then
+                       result:=cloadvmtaddrnode.create(result);
                      do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]);
                    end
                   else

tests/webtbs/tw24844.pp

@@ -0,0 +1,49 @@
+program method_init;
+
+{$mode objfpc}
+{.$mode delphi}
+
+Type
+
+ { TObj }
+
+ TObj = Class
+   procedure Test;
+ end;
+
+{ TObj }
+
+procedure TObj.Test;
+Var
+
+ proc : procedure of object;
+
+begin
+
+  proc := {$IFNDEF FPC_DELPHI}@{$ENDIF}TObject.Create.Free;
+  WriteLn('Expected TObject actual: ', TObject(TMethod(Proc).Data).ClassName);
+  if TObject(TMethod(Proc).Data).ClassName<>'TObject' then
+    halt(1);
+end;
+
+procedure UncompilableProc;
+Var
+
+ proc : procedure of object;
+
+begin
+
+  proc := {$IFNDEF FPC_DELPHI}@{$ENDIF}TObject.Create.Free; // uncompilable in FPC mode
+  WriteLn('Expected TObject actual: ', TObject(TMethod(Proc).Data).ClassName);
+  if TObject(TMethod(Proc).Data).ClassName<>'TObject' then
+    halt(2);
+end;
+
+begin
+
+  WriteLn('Mode: ', {$IFDEF FPC_DELPHI}'delphi'{$ELSE}'objfpc'{$ENDIF});
+
+  TObj.Create.Test;
+  UncompilableProc;
+
+end.

tests/webtbs/tw24844a.pp

@@ -0,0 +1,49 @@
+program method_init;
+
+{.$mode objfpc}
+{$mode delphi}
+
+Type
+
+ { TObj }
+
+ TObj = Class
+   procedure Test;
+ end;
+
+{ TObj }
+
+procedure TObj.Test;
+Var
+
+ proc : procedure of object;
+
+begin
+
+  proc := {$IFNDEF FPC_DELPHI}@{$ENDIF}TObject.Create.Free;
+  WriteLn('Expected TObject actual: ', TObject(TMethod(Proc).Data).ClassName);
+  if TObject(TMethod(Proc).Data).ClassName<>'TObject' then
+    halt(1);
+end;
+
+procedure UncompilableProc;
+Var
+
+ proc : procedure of object;
+
+begin
+
+  proc := {$IFNDEF FPC_DELPHI}@{$ENDIF}TObject.Create.Free; // uncompilable in FPC mode
+  WriteLn('Expected TObject actual: ', TObject(TMethod(Proc).Data).ClassName);
+  if TObject(TMethod(Proc).Data).ClassName<>'TObject' then
+    halt(2);
+end;
+
+begin
+
+  WriteLn('Mode: ', {$IFDEF FPC_DELPHI}'delphi'{$ELSE}'objfpc'{$ENDIF});
+
+  TObj.Create.Test;
+  UncompilableProc;
+
+end.

tests/webtbs/tw24844b.pp

@@ -0,0 +1,51 @@
+program method_init;
+
+{$mode objfpc}
+{.$mode delphi}
+
+Type
+
+ { TObj }
+
+ TObj = Class
+  class var
+   a: record
+    b: byte;
+   end;
+   procedure Test;
+ end;
+
+{ TObj }
+
+procedure TObj.Test;
+Var
+
+ proc : procedure of object;
+ p : pbyte;
+begin
+  a.b:=5;
+  p:=@tobj.create.a.b;
+  if p^<>5 then
+    halt(1);
+end;
+
+procedure UncompilableProc;
+Var
+
+ proc : procedure of object;
+ p : pbyte;
+begin
+  tobj.a.b:=6;
+  p:=@tobj.create.a.b;
+  if p^<>6 then
+    halt(2);
+end;
+
+begin
+
+  WriteLn('Mode: ', {$IFDEF FPC_DELPHI}'delphi'{$ELSE}'objfpc'{$ENDIF});
+
+  TObj.Create.Test;
+  UncompilableProc;
+
+end.

tests/webtbs/tw24844c.pp

@@ -0,0 +1,51 @@
+program method_init;
+
+{.$mode objfpc}
+{$mode delphi}
+
+Type
+
+ { TObj }
+
+ TObj = Class
+  class var
+   a: record
+    b: byte;
+   end;
+   procedure Test;
+ end;
+
+{ TObj }
+
+procedure TObj.Test;
+Var
+
+ proc : procedure of object;
+ p : pbyte;
+begin
+  a.b:=5;
+  p:=@tobj.create.a.b;
+  if p^<>5 then
+    halt(1);
+end;
+
+procedure UncompilableProc;
+Var
+
+ proc : procedure of object;
+ p : pbyte;
+begin
+  tobj.a.b:=6;
+  p:=@tobj.create.a.b;
+  if p^<>6 then
+    halt(2);
+end;
+
+begin
+
+  WriteLn('Mode: ', {$IFDEF FPC_DELPHI}'delphi'{$ELSE}'objfpc'{$ENDIF});
+
+  TObj.Create.Test;
+  UncompilableProc;
+
+end.