Test suite results for test file test/units/system/tjmp.pp

Test run data :

View Test suite results

Test file "test/units/system/tjmp.pp" information:

t_id 232
t_adddate 2003/10/03
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 50

Total = 50

OK=43 Percentage= 86.00

Source:

{ 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

}

Link to SVN view of test/units/system/tjmp.pp source.