mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-24 05:19:37 +02:00
* 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 -
This commit is contained in:
parent
2a990b8167
commit
cbe352808a
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
56
tests/webtbs/tw38238.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user