Pārlūkot izejas kodu

Fix for Mantis #26177. Use the correct value for the method data when using a method pointer of a type or record helper.

Please note that Delphi has the exact same bug as we have and thus code working in FPC will not work in Delphi.
Additionally taking the method address of a local variable or a local/global constant for a method pointer is dangerous as the variable (in case of constants is a temporary local variable) will go out of scope once the containing procedure/function/method exits!

ncgld.pas, tcgloadnode.pass_generate_code:
  * only use the value of Self if it is an implicit pointer object (class instance) or a class reference, but not for everything else (objects, records, primitive types)

+added test

git-svn-id: trunk@28160 -
svenbarth 11 gadi atpakaļ
vecāks
revīzija
441e6c6083
3 mainītis faili ar 41 papildinājumiem un 1 dzēšanām
  1. 1 0
      .gitattributes
  2. 2 1
      compiler/ncgld.pas
  3. 38 0
      tests/webtbs/tw26177.pp

+ 1 - 0
.gitattributes

@@ -13978,6 +13978,7 @@ tests/webtbs/tw2602.pp svneol=native#text/plain
 tests/webtbs/tw2607.pp svneol=native#text/plain
 tests/webtbs/tw26123.pp svneol=native#text/pascal
 tests/webtbs/tw26162.pp svneol=native#text/pascal
+tests/webtbs/tw26177.pp svneol=native#text/pascal
 tests/webtbs/tw26180.pp svneol=native#text/pascal
 tests/webtbs/tw2620.pp svneol=native#text/plain
 tests/webtbs/tw26226.pp -text svneol=native#text/plain

+ 2 - 1
compiler/ncgld.pas

@@ -491,7 +491,8 @@ implementation
                         LOC_CREFERENCE,
                         LOC_REFERENCE:
                           begin
-                             if not is_object(left.resultdef) then
+                             if is_implicit_pointer_object_type(left.resultdef) or 
+                                 (left.resultdef.typ=classrefdef) then
                                begin
                                  location.registerhi:=hlcg.getaddressregister(current_asmdata.CurrAsmList,left.resultdef);
                                  hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location.reference,location.registerhi)

+ 38 - 0
tests/webtbs/tw26177.pp

@@ -0,0 +1,38 @@
+program tw26177;
+
+{$MODE DELPHI}
+{$MODESWITCH TYPEHELPERS}
+
+uses
+  Classes;
+
+type
+  TInt32Helper = record helper for Int32
+    procedure Foo(Sender: TObject);
+  end;
+
+var
+  value: Int32 = 0;
+
+procedure TInt32Helper.Foo(Sender: TObject);
+begin
+  value := Self;
+end;
+
+var
+  i: Int32 = 10;
+  m: TNotifyEvent;
+begin
+  m := i.Foo;
+  // Data is equal 10 (!) but should be equal to @i
+  //WriteLn(Int32(TMethod(m).Data));
+  // TMethod(m).Data := @i; < workaround for bug
+  try
+    m(nil); // External SIGSEGV!
+    if value <> 10 then
+      Halt(2);
+  except
+    Halt(1);
+  end;
+end.
+