t_id
232
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
525542877 | 948202 | True | False | Successfully run |
Record count: 1
{ Tests the system unit routines for longjmp and setjmp } { By Carl Eric Codere - Copyright (c) 2002 } program tjmp; var global_envbuf: jmp_buf; type tmyobject = object envbuf : jmp_buf; j : integer; jmpresult : integer; constructor init; destructor done; procedure testlongjmp;virtual; procedure testsetjmp;virtual; end; pderivedobject = ^tderivedobject; tderivedobject = object(tmyobject) procedure testlongjmp; virtual; procedure testsetjmp; virtual; end; constructor tmyobject.init; begin end; destructor tmyobject.done; begin end; procedure tmyobject.testlongjmp; begin end; procedure tmyobject.testsetjmp; begin end; procedure tderivedobject.testlongjmp; begin longjmp(envbuf, 255); end; procedure tderivedobject.testsetjmp; var i : integer; begin j:=0; jmpresult:=setjmp(envbuf); case jmpresult of 0 : begin for i:=0 to 255 do begin j:=j + 13; if j = 13 then self.testlongjmp; end; end; 255 : WriteLn('Sucess!'); else begin WriteLn('Failure!'); halt(1); end end; end; procedure testlongjmp; begin longjmp(global_envbuf, 255); end; procedure testsetjmp; var i, j : integer; jmpresult : integer; begin j:=0; jmpresult:=setjmp(global_envbuf); case jmpresult of 0 : begin for i:=0 to 255 do begin j:=j + 13; if j = 13 then testlongjmp; end; end; 255 : WriteLn('Sucess!'); else begin WriteLn('Failure!'); halt(1); end end; end; var pobj : pderivedobject; begin Write('Testing setjmp/longjmp simple case...'); testsetjmp; Write('Testing setjmp/longjmp in virtual method...'); pobj:=new(pderivedobject, init); pobj^.testsetjmp; dispose(pobj, done); end. { $Log: tjmp.pp,v $ Revision 1.2 2003/05/10 09:55:00 peter * fix loop variable Revision 1.1 2002/09/15 09:53:05 carl * initial revision of longjmp/setjmp testing }