mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 21:59:27 +02:00
f455d66a75
* apply patch by Blaise.ru to allow record methods to be assigned to method variables as well (this is Delphi compatible) + added test ........ * apply patch by Blaise.ru to allow specializations for the result type of function and method variables + added tests ........ * 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: branches/fixes_3_2@48653 -
57 lines
921 B
ObjectPascal
57 lines
921 B
ObjectPascal
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.
|