Przeglądaj źródła

* fix for Mantis #38238: when creating a copy of a procdef for a procvar set the methodpointer flag also for methods of records
+ added test

git-svn-id: trunk@47826 -

svenbarth 4 lat temu
rodzic
commit
cbe352808a
3 zmienionych plików z 58 dodań i 1 usunięć
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/symdef.pas
  3. 56 0
      tests/webtbs/tw38238.pp

+ 1 - 0
.gitattributes

@@ -18613,6 +18613,7 @@ tests/webtbs/tw38164.pp svneol=native#text/pascal
 tests/webtbs/tw38201.pp svneol=native#text/pascal
 tests/webtbs/tw38202.pp svneol=native#text/pascal
 tests/webtbs/tw38225.pp svneol=native#text/pascal
+tests/webtbs/tw38238.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain

+ 1 - 1
compiler/symdef.pas

@@ -5811,7 +5811,7 @@ implementation
 {$endif}
         if (typ=procdef) and
            (newtyp=procvardef) and
-           (owner.symtabletype=ObjectSymtable) then
+           (owner.symtabletype in [ObjectSymtable,recordsymtable]) then
           include(tprocvardef(result).procoptions,po_methodpointer);
       end;
 

+ 56 - 0
tests/webtbs/tw38238.pp

@@ -0,0 +1,56 @@
+program tw38238;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TCallback = procedure(AValue: longint) of object;
+
+  TRec = record
+    Clb: TCallback;
+    procedure AddCallback(ACallback: TCallback);
+    procedure TriggerCallback(AValue: longint);
+  end;
+
+  TRec2 = record
+    Value: longint;
+    Rec: TRec;
+    procedure CLB(AValue: longint);
+    procedure InitStuff;
+  end;
+
+procedure TRec.AddCallback(ACallback: TCallback);
+begin
+  Clb:=ACallback;
+end;
+
+procedure TRec.TriggerCallback(AValue: longint);
+begin
+  if assigned(Clb) then
+    Clb(AValue);
+end;
+
+procedure TRec2.CLB(AValue: longint);
+begin
+  Value:=AValue;
+end;
+
+procedure TRec2.InitStuff;
+begin
+  Rec.AddCallback(@CLB);
+end;
+
+var
+  Rec1, Rec2: TRec2;
+begin
+  Rec1.InitStuff;
+  Rec2.InitStuff;
+
+  Rec1.Rec.TriggerCallback(1234);
+  Rec2.Rec.TriggerCallback($0943);
+
+  if Rec1.Value<>1234 then
+    Halt(1);
+  if Rec2.Value<>$0943 then
+    Halt(2);
+end.