mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 01:29:19 +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/tw38201.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw38202.pp svneol=native#text/pascal
|
tests/webtbs/tw38202.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw38225.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/tw3827.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3829.pp svneol=native#text/plain
|
tests/webtbs/tw3829.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3833.pp svneol=native#text/plain
|
tests/webtbs/tw3833.pp svneol=native#text/plain
|
||||||
|
@ -5811,7 +5811,7 @@ implementation
|
|||||||
{$endif}
|
{$endif}
|
||||||
if (typ=procdef) and
|
if (typ=procdef) and
|
||||||
(newtyp=procvardef) and
|
(newtyp=procvardef) and
|
||||||
(owner.symtabletype=ObjectSymtable) then
|
(owner.symtabletype in [ObjectSymtable,recordsymtable]) then
|
||||||
include(tprocvardef(result).procoptions,po_methodpointer);
|
include(tprocvardef(result).procoptions,po_methodpointer);
|
||||||
end;
|
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