mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 06:19:37 +01:00 
			
		
		
		
	no message
This commit is contained in:
		
							parent
							
								
									97d4723f45
								
							
						
					
					
						commit
						2d4ade242c
					
				
							
								
								
									
										66
									
								
								tests/webtbs/tw3657.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										66
									
								
								tests/webtbs/tw3657.pp
									
									
									
									
									
										Normal 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.
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user