no message

This commit is contained in:
florian 2005-03-06 21:30:21 +00:00
parent 97d4723f45
commit 2d4ade242c

66
tests/webtbs/tw3657.pp Normal file
View File

@ -0,0 +1,66 @@
{ Source provided for Free Pascal Bug Report 3657 }
{ Submitted by "Sergey@michint" on 2005-02-15 }
{ e-mail: }
// Title: Crash when text of tlabel is empty
{$mode objfpc}
{$C+}
PROGRAM TestApp;
USES SysUtils, Objects, Video, Drivers, fvcommon, Views, App, Dialogs, FVConsts;
TYPE
PTVDemo = ^TTVDemo;
TTVDemo = OBJECT (TApplication)
pc: Integer; // "program counter"
l: PLabel;
PROCEDURE Idle; virtual;
End;
PROCEDURE TTVDemo.Idle;
var
Event: TEvent;
R: TRect;
begin
inherited;
inc(pc);
case pc of // test script
1: begin
R.Assign(5, 5, 10, 1);
New(L, Init(R, '', nil));
Desktop^.Insert(L);
Event.What:=evKeyDown;
Event.KeyCode:=kbAltC;
Event.InfoPtr := Nil;
PutEvent(Event);
end;
2: begin
Event.What:=evCommand;
Event.Command:=cmQuit;
Event.InfoPtr := Nil;
PutEvent(Event);
end;
3: Assert(False, 'Quit fail');
end;
end;
var
MyApp: TTVDemo;
BEGIN
try Assert(False, 'assert test');
raise Exception.Create('assertions don''t not work');
except on E: EAssertionFailed do {nothing} else raise; end;
try
MyApp.Init; { Initialize app }
MyApp.pc:=0;
try
MyApp.Run; { Run the app }
finally
MyApp.Done; { Dispose of app }
end;
Writeln('fv_label.pas - Ok');
except
Writeln('fv_label.pas - Error');
raise;
end;
END.