Browse Source

depends on FV

peter 20 years ago
parent
commit
eb012fc86f
1 changed files with 0 additions and 66 deletions
  1. 0 66
      tests/webtbs/tw3657.pp

+ 0 - 66
tests/webtbs/tw3657.pp

@@ -1,66 +0,0 @@
-{ 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.