mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 00:09:25 +02:00
no message
This commit is contained in:
parent
5007b3e395
commit
2fa0967349
31
tests/tbs/tb0483.pp
Normal file
31
tests/tbs/tb0483.pp
Normal file
@ -0,0 +1,31 @@
|
||||
{$mode delphi}
|
||||
{ this should be only allowed in delphi mode; it's a delphi bug }
|
||||
uses
|
||||
tb0483u;
|
||||
|
||||
type
|
||||
tmyclass2 = class(tmyclass1)
|
||||
procedure x(var l : longint);message 1234;
|
||||
end;
|
||||
|
||||
procedure tmyclass2.x(var l : longint);
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
var
|
||||
myclass2 : tmyclass2;
|
||||
l : longint;
|
||||
|
||||
begin
|
||||
myclass2:=tmyclass2.create;
|
||||
myclass2.x(l);
|
||||
myclass2.free;
|
||||
if testresult<>1 then
|
||||
begin
|
||||
writeln('error');
|
||||
halt(1);
|
||||
end;
|
||||
writeln('ok');
|
||||
end.
|
||||
|
33
tests/tbs/tb0483u.pp
Normal file
33
tests/tbs/tb0483u.pp
Normal file
@ -0,0 +1,33 @@
|
||||
{$mode delphi}
|
||||
unit tb0483u;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
tmyclass1 = class
|
||||
private
|
||||
procedure x(var l : longint);message 1234;
|
||||
public
|
||||
procedure defaulthandler(var msg);override;
|
||||
end;
|
||||
|
||||
const
|
||||
testresult : longint = 0;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
procedure tmyclass1.defaulthandler(var msg);
|
||||
begin
|
||||
writeln('error; being in tmyclass1.defaulthandler');
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
|
||||
procedure tmyclass1.x(var l : longint);
|
||||
begin
|
||||
testresult:=1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user