* fix for Mantis : 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 -
This commit is contained in:
svenbarth 2020-12-20 22:41:27 +00:00
parent 2a990b8167
commit cbe352808a
3 changed files with 58 additions and 1 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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
tests/webtbs/tw38238.pp Normal file
View File

@ -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.