mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-09 09:46:00 +02:00
+ Added bug #249
This commit is contained in:
parent
b0b561fa95
commit
8b489a0f24
59
bugs/bug0249.pp
Normal file
59
bugs/bug0249.pp
Normal file
@ -0,0 +1,59 @@
|
||||
program TestEvent;
|
||||
|
||||
{$M+}
|
||||
|
||||
type
|
||||
TNotifyEvent = procedure( Sender: TObject ) of object;
|
||||
|
||||
THost = class
|
||||
FOnEvent: TNotifyEvent;
|
||||
procedure SetOnEvent( Value: TNotifyEvent );
|
||||
public
|
||||
constructor Create;
|
||||
procedure Trigger;
|
||||
procedure SayHello;
|
||||
published
|
||||
property OnEvent: TNotifyEvent read FOnEvent write SetOnEvent;
|
||||
end;
|
||||
|
||||
TDummy = class
|
||||
procedure HandleEvent( Sender: TObject );
|
||||
end;
|
||||
|
||||
constructor THost.Create;
|
||||
begin
|
||||
FOnEvent := nil;
|
||||
end;
|
||||
|
||||
procedure THost.Trigger;
|
||||
begin
|
||||
if @FOnEvent <> nil then
|
||||
FOnEvent( Self )
|
||||
end;
|
||||
|
||||
procedure THost.SetOnEvent( Value: TNotifyEvent );
|
||||
begin
|
||||
FOnEvent := Value
|
||||
end;
|
||||
|
||||
procedure THost.SayHello;
|
||||
begin
|
||||
Writeln( 'Hello event' )
|
||||
end;
|
||||
|
||||
procedure TDummy.HandleEvent( Sender: TObject );
|
||||
begin
|
||||
THost( Sender ).SayHello
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
Host: THost;
|
||||
Dummy: TDummy;
|
||||
begin
|
||||
Dummy := TDummy.Create;
|
||||
Host := THost.Create;
|
||||
with Host,Dummy do
|
||||
OnEvent := HandleEvent; // this is 57, 27 is ";"
|
||||
Host.Trigger;
|
||||
end.
|
@ -342,3 +342,4 @@ bug0243.pp Arguments of functions are computed from right to left this
|
||||
bug0244.pp nested procedures can't have same name as global ones
|
||||
bug0245.pp assigning pointers to address of consts is allowed (refused by BP !)
|
||||
bug0246.pp const para can be changed without error
|
||||
bug0249.pp procedure of object cannot be assigned to property.
|
Loading…
Reference in New Issue
Block a user