t_id
232
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
| tr_id | run | tr_ok | tr_skip | tr_result |
|---|---|---|---|---|
| 458818728 | 937402 | 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
}