瀏覽代碼

no message

florian 20 年之前
父節點
當前提交
2d4ade242c
共有 1 個文件被更改,包括 66 次插入0 次删除
  1. 66 0
      tests/webtbs/tw3657.pp

+ 66 - 0
tests/webtbs/tw3657.pp

@@ -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.