t_id
219
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
526133130 | 948304 | True | False | Successfully run |
Record count: 1
{$C+} program tassert2; var global_boolean : boolean; counter : longint; const RESULT_BOOLEAN = false; procedure fail; begin Writeln('Failure!'); Halt(1); end; function get_boolean : boolean; begin get_boolean := RESULT_BOOLEAN; end; procedure test_assert_reference_global; begin global_boolean:=RESULT_BOOLEAN; assert(global_boolean); end; procedure test_assert_reference_local; var b: boolean; begin b:=RESULT_BOOLEAN; assert(b); end; procedure test_assert_register; begin assert(get_boolean); end; procedure test_assert_flags; var i,j : integer; begin i:=0; j:=-12; assert(i < j); end; procedure test_assert_constant; begin assert(RESULT_BOOLEAN); end; { Handle the assertion failed ourselves, so we can test everything in one shot. } Procedure MyAssertRoutine(const msg,fname:ShortString;lineno:longint;erroraddr:{$ifdef VER1_0}longint{$else}pointer{$endif}); begin Inc(counter); end; begin counter:=0; AssertErrorProc := @MyAssertRoutine; Write('Assert test (FALSE)...'); test_assert_reference_global; test_assert_reference_local; test_assert_register; test_assert_flags; test_assert_constant; if counter <> 5 then fail else WriteLn('Success!'); end. { $Log: tassert2.pp,v $ Revision 1.2 2003/03/17 19:27:00 peter * fixed for 1.1 compiler Revision 1.1 2002/09/16 19:16:36 carl * several new routines have a testsuit. }