no message

This commit is contained in:
florian 2005-02-01 23:06:55 +00:00
parent 5007b3e395
commit 2fa0967349
2 changed files with 64 additions and 0 deletions

31
tests/tbs/tb0483.pp Normal file
View 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
View 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.