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

Test run data :

Run ID:
Operating system: linux
Processor: i386
Version: 3.3.1
Fails/OK/Total: 238/9417/9655
Version: 3.3.1
Full version: 3.3.1-15587-g490a8c68ea-unpushed
Comment: -XR/home/muller/sys-root/i386-linux -Xd -Xr/home/muller/sys-root/i386-linux
Machine: cfarm13
Category: 1
SVN revisions: 490a8c68ea:8b7dbb81b1:3f8bbd3b00:2f9ed0576e
Submitter: muller
Date: 2024/04/19 11:03:00
Previous run: 934303
Next run: 935638

Hide skipped tests

Hide successful tests

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

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

Detailed test run results:

tr_idruntr_oktr_skiptr_result
443811996934990TrueFalseSuccessfully run

Record count: 1

No log of 934990.

Source: 

{ Program to test the system unit inc/dec routines }
{ By Carl Eric Codere Copyright (c) 2002           }
program tincdec;

const
   INCDEC_COUNT_SIMPLE = 8;  
   INCDEC_COUNT_COMPLEX = -12;
   
   INIT_U8BIT = $0F;
   INIT_U16BIT = $FF00;
   INIT_U32BIT = $FF00FF00;
   
   INIT_S8BIT = $0F;
   INIT_S16BIT = -13333;
   INIT_S32BIT = -2335754;
   INIT_S64BIT = Low(longint);
var
 global_s8bit : shortint;
 global_s16bit : smallint;
 global_s32bit :longint;
 global_s64bit : int64;
 global_u8bit : byte;
 global_u16bit : word;
 global_u32bit : longword;
 { the result must be calculated manually since
   FPC 1.0.x does not support adding directly 64-bit
   constants
 }  
 result_s64bit_complex : int64;
 
 procedure init_globals;
   begin
    global_s8bit := INIT_S8BIT;
    global_s16bit := INIT_S16BIT;
    global_s32bit := longint(INIT_S32BIT);
    global_s64bit := INIT_S64BIT; 
    global_u8bit := INIT_U8BIT;
    global_u16bit := INIT_U16BIT;
    global_u32bit := INIT_U32BIT;
    result_s64bit_complex := INIT_S64BIT;
    result_s64bit_complex := result_s64bit_complex + INCDEC_COUNT_COMPLEX;
   end;
   
   
   
  procedure fail;
    begin
      WriteLn('Failed!');
      Halt(1);
    end;
    
  function getcomplex_count_s32 : longint;
   begin
     getcomplex_count_s32 := INCDEC_COUNT_COMPLEX;
   end;
   
  function getcomplex_count_s8 :shortint;
   begin
     getcomplex_count_s8 := INCDEC_COUNT_COMPLEX;
   end;
   
  function getcomplex_count_s64 : int64;
   begin
     getcomplex_count_s64 := INCDEC_COUNT_COMPLEX;
   end;
   
{***********************************************************************}
{                              INC                                      }
{***********************************************************************}
 
procedure test_inc_s8;
   var
    b: smallint;
    _result : boolean;
 begin
   _result := true;
   Write('Inc() signed 8-bit tests...');

   init_globals;
   Inc(global_s8bit);
   if global_S8bit <> (INIT_S8BIT+1) then
     _result := false;
   
   init_globals;
   Inc(global_S8bit, INCDEC_COUNT_SIMPLE);
   if global_S8bit <> (INCDEC_COUNT_SIMPLE+INIT_S8BIT) then
     _result := false;
     
   init_globals;
   Inc(global_S8bit, INCDEC_COUNT_COMPLEX);
   if global_S8bit <> (INCDEC_COUNT_COMPLEX+INIT_S8BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   Inc(global_S8bit, b);
   if global_S8bit <> (INCDEC_COUNT_SIMPLE+INIT_S8BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   Inc(global_S8bit, b);
   if global_S8bit <> (INCDEC_COUNT_COMPLEX+INIT_S8BIT) then
     _result := false;

   init_globals;
   Inc(global_S8bit, getcomplex_count_s32);
   if global_S8bit <> (INCDEC_COUNT_COMPLEX+INIT_S8BIT) then
     _result := false;
     
   init_globals;
   Inc(global_S8bit, getcomplex_count_s8);
   if global_S8bit <> (INCDEC_COUNT_COMPLEX+INIT_S8BIT) then
     _result := false;
     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;
 
procedure test_inc_s16;
   var
    b: smallint;
    _result : boolean;
 begin
   _result := true;
   Write('Inc() signed 16-bit tests...');

   init_globals;
   Inc(global_s16bit);
   if global_S16bit <> (INIT_S16BIT+1) then
     _result := false;
   
   init_globals;
   Inc(global_s16bit, INCDEC_COUNT_SIMPLE);
   if global_s16bit <> (INCDEC_COUNT_SIMPLE+INIT_s16BIT) then
     _result := false;
     
   init_globals;
   Inc(global_s16bit, INCDEC_COUNT_COMPLEX);
   if global_s16bit <> (INCDEC_COUNT_COMPLEX+INIT_s16BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   Inc(global_s16bit, b);
   if global_s16bit <> (INCDEC_COUNT_SIMPLE+INIT_s16BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   Inc(global_s16bit, b);
   if global_s16bit <> (INCDEC_COUNT_COMPLEX+INIT_s16BIT) then
     _result := false;

   init_globals;
   Inc(global_s16bit, getcomplex_count_s32);
   if global_s16bit <> (INCDEC_COUNT_COMPLEX+INIT_s16BIT) then
     _result := false;
     
   init_globals;
   Inc(global_s16bit, getcomplex_count_s8);
   if global_s16bit <> (INCDEC_COUNT_COMPLEX+INIT_s16BIT) then
     _result := false;
     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;

procedure test_inc_s32;
   var
    b: smallint;
    _result : boolean;
 begin
    _result := true;
   Write('Inc() signed 32-bit tests...');

   init_globals;
   Inc(global_s32bit);
   if global_S32bit <> (INIT_S32BIT+1) then
     _result := false;
   
   init_globals;
   Inc(global_s32bit, INCDEC_COUNT_SIMPLE);
   if global_s32bit <> (INCDEC_COUNT_SIMPLE+INIT_s32BIT) then
     _result := false;
     
   init_globals;
   Inc(global_s32bit, INCDEC_COUNT_COMPLEX);
   if global_s32bit <> (INCDEC_COUNT_COMPLEX+INIT_s32BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   Inc(global_s32bit, b);
   if global_s32bit <> (INCDEC_COUNT_SIMPLE+INIT_s32BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   Inc(global_s32bit, b);
   if global_s32bit <> (INCDEC_COUNT_COMPLEX+INIT_s32BIT) then
     _result := false;

   init_globals;
   Inc(global_s32bit, getcomplex_count_s32);
   if global_s32bit <> (INCDEC_COUNT_COMPLEX+INIT_s32BIT) then
     _result := false;
     
   init_globals;
   Inc(global_s32bit, getcomplex_count_s8);
   if global_s32bit <> (INCDEC_COUNT_COMPLEX+INIT_s32BIT) then
     _result := false;
     
   init_globals;
   Inc(global_s32bit, getcomplex_count_s64);
   if global_s32bit <> (INCDEC_COUNT_COMPLEX+INIT_s32BIT) then
     _result := false;
     
     
   if not _result then
      fail
   else
     WriteLn('Success!');
end;

procedure test_inc_s64;
   var
    b: int64;
    _result : boolean;
 begin
   _result := true;
   Write('Inc() signed 64-bit tests...');

   init_globals;
   Inc(global_s64bit);
   if global_S64bit <> (result_s64bit_complex-INCDEC_COUNT_COMPLEX+1) then
     _result := false;
   
   init_globals;
   Inc(global_s64bit, INCDEC_COUNT_COMPLEX);
   if global_s64bit <> (result_s64bit_complex) then
     _result := false;
     
   init_globals;
   Inc(global_s64bit, INCDEC_COUNT_COMPLEX);
   if global_s64bit <> (result_s64bit_complex) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   Inc(global_s64bit, b);
   if global_s64bit <> (result_s64bit_complex) then
     _result := false;

{$ifndef ver1_0}
   init_globals;
   Inc(global_s64bit, getcomplex_count_s8);
   if global_s64bit <> (INCDEC_COUNT_COMPLEX+INIT_S64BIT) then
     _result := false;
     
   init_globals;
   Inc(global_s64bit, getcomplex_count_s32);
   if global_s64bit <> (INCDEC_COUNT_COMPLEX+INIT_s64BIT) then
     _result := false;
     
     
{$endif}     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;


procedure test_inc_u32;
   var
    b: smallint;
    _result : boolean;
 begin
    _result := true;
   Write('Inc() unsigned 32-bit tests...');

   init_globals;
   Inc(global_u32bit);
   if global_u32bit <> (INIT_U32BIT+1) then
     _result := false;
   
   init_globals;
   Inc(global_u32bit, INCDEC_COUNT_SIMPLE);
   if global_u32bit <> (INCDEC_COUNT_SIMPLE+INIT_u32BIT) then
     _result := false;
     
   init_globals;
   Inc(global_u32bit, INCDEC_COUNT_COMPLEX);
   if global_u32bit <> (INCDEC_COUNT_COMPLEX+INIT_u32BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   Inc(global_u32bit, b);
   if global_u32bit <> (INCDEC_COUNT_SIMPLE+INIT_u32BIT) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   Inc(global_u32bit, b);
   if global_u32bit <> (INCDEC_COUNT_COMPLEX+INIT_u32BIT) then
     _result := false;

   init_globals;
   Inc(global_u32bit, getcomplex_count_s32);
   if global_u32bit <> (INCDEC_COUNT_COMPLEX+INIT_u32BIT) then
     _result := false;
     
   init_globals;
   Inc(global_u32bit, getcomplex_count_s8);
   if global_u32bit <> (INCDEC_COUNT_COMPLEX+INIT_u32BIT) then
     _result := false;
     
   init_globals;
   Inc(global_u32bit, getcomplex_count_s64);
   if global_u32bit <> (INCDEC_COUNT_COMPLEX+INIT_u32BIT) then
     _result := false;
     
     
   if not _result then
      fail
   else
     WriteLn('Success!');
end;

{***********************************************************************}
{                              DEC                                      }
{***********************************************************************}
procedure test_dec_s8;
   var
    b: smallint;
    _result : boolean;
    l: byte;
 begin
   _result := true;
   Write('dec() signed 8-bit tests...');
   
   init_globals;
   dec(global_S8bit, INCDEC_COUNT_SIMPLE);
   if global_S8bit <> (INIT_S8BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   dec(global_S8bit, INCDEC_COUNT_COMPLEX);
   if global_S8bit <>  (INIT_S8BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   dec(global_S8bit, b);
   if global_S8bit <> (INIT_S8BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   dec(global_S8bit, b);
   if global_S8bit <> (INIT_S8BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;

   init_globals;
   dec(global_S8bit, getcomplex_count_s32);
   if global_S8bit <> (INIT_S8BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_S8bit, getcomplex_count_s8);
   if global_S8bit <> (INIT_S8BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   { extra test for overflow checking }
   l:=byte(high(shortint));
   global_s8bit := high(shortint);
   dec(global_s8bit,l);
   if global_s8bit <> 0 then
     _result := false;
     
     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;
 
procedure test_dec_s16;
   var
    b: smallint;
    _result : boolean;
 begin
   _result := true;
   Write('dec() signed 16-bit tests...');
   
   init_globals;
   dec(global_s16bit, INCDEC_COUNT_SIMPLE);
   if global_s16bit <> (INIT_S16BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   dec(global_s16bit, INCDEC_COUNT_COMPLEX);
   if global_s16bit <> (INIT_S16BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   dec(global_s16bit, b);
   if global_s16bit <> (INIT_S16BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   dec(global_s16bit, b);
   if global_s16bit <> (INIT_S16BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;

   init_globals;
   dec(global_s16bit, getcomplex_count_s32);
   if global_s16bit <> (INIT_S16BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_s16bit, getcomplex_count_s8);
   if global_s16bit <> (INIT_S16BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;

procedure test_dec_s32;
   var
    b: smallint;
    _result : boolean;
 begin
    _result := true;
   Write('dec() signed 32-bit tests...');
   
   init_globals;
   dec(global_s32bit, INCDEC_COUNT_SIMPLE);
   if global_s32bit <> (INIT_S32BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   dec(global_s32bit, INCDEC_COUNT_COMPLEX);
   if global_s32bit <> (INIT_S32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   dec(global_s32bit, b);
   if global_s32bit <>  (INIT_S32BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   dec(global_s32bit, b);
   if global_s32bit <> (INIT_S32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;

   init_globals;
   dec(global_s32bit, getcomplex_count_s32);
   if global_s32bit <> (INIT_S32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_s32bit, getcomplex_count_s8);
   if global_s32bit <> (INIT_S32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_s32bit, getcomplex_count_s64);
   if global_s32bit <> (INIT_S32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
     
   if not _result then
      fail
   else
     WriteLn('Success!');
end;

procedure test_dec_s64;
   var
    b: smallint;
    _result : boolean;
 begin
   _result := true;
   Write('dec() signed 64-bit tests...');
   

{$ifndef ver1_0}
   init_globals;
   dec(global_s64bit, getcomplex_count_s8);
   if global_s64bit <> (INIT_S64BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_s64bit, getcomplex_count_s32);
   if global_s64bit <> (INIT_S64BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
{$endif}     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;

procedure test_dec_u32;
   var
    b: smallint;
    _result : boolean;
 begin
    _result := true;
   Write('dec() unsigned 32-bit tests...');
   
   init_globals;
   dec(global_u32bit, INCDEC_COUNT_SIMPLE);
   if global_u32bit <> (INIT_u32BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   dec(global_u32bit, INCDEC_COUNT_COMPLEX);
   if global_u32bit <> (INIT_u32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_SIMPLE;
   dec(global_u32bit, b);
   if global_u32bit <>  (INIT_u32BIT-INCDEC_COUNT_SIMPLE) then
     _result := false;
     
   init_globals;
   b:= INCDEC_COUNT_COMPLEX;
   dec(global_u32bit, b);
   if global_u32bit <> (INIT_u32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;

   init_globals;
   dec(global_u32bit, getcomplex_count_s32);
   if global_u32bit <> (INIT_u32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_u32bit, getcomplex_count_s8);
   if global_u32bit <> (INIT_u32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
     
   init_globals;
   dec(global_u32bit, getcomplex_count_s64);
   if global_u32bit <> (INIT_u32BIT-INCDEC_COUNT_COMPLEX) then
     _result := false;
   
     
     
   if not _result then
      fail
   else
     WriteLn('Success!');
end;


procedure test_inc_ptr;
   type 
     tstruct = packed record
      b: byte;
      w: word;
     end; 
   const
      word_array : array[1..4] of word =
      ($0000,$FFFF,$F0F0,$F00F);
      struct_array : array[1..4] of tstruct = (
       (b:00;w:0001),
       (b:01;w:0102),
       (b:02;w:0203),
       (b:03;w:0304)
      ); 
   var
    _result : boolean;
    pw : ^word;
    podd : ^tstruct;
    i: integer;
    B : byte;
 begin
    _result := true;
   Write('Inc() pointer to word...');
   pw:=@word_array;
   for i:=1 to 4 do
     begin
        if (word_array[i] <> pw^) then
          _result := false;
        Inc(pw)  
     end;
     
   pw:=@word_array;
   inc(pw,2);
   if pw^<>word_array[3] then
     _result := false;

   pw:=@word_array;
   b:=2;
   inc(pw,b);
   if pw^<>word_array[3] then
     _result := false;

   podd:=@struct_array;
   b:=3;
   inc(podd,b);
   if (podd^.b<>struct_array[4].b) and (podd^.w<>struct_array[4].w) then
     _result := false;
     
   podd:=@struct_array;
   inc(podd,3);
   if (podd^.b<>struct_array[4].b) and (podd^.w<>struct_array[4].w) then
     _result := false;
     
   if not _result then
      fail
   else
     WriteLn('Success!');
 end;
  
 
Begin
  test_inc_s8;
  test_inc_s16;
  test_inc_s32;
  test_inc_s64;
  test_inc_u32;
  test_inc_ptr;
  
  test_dec_s8;
  test_dec_s16;
  test_dec_s32;
  test_dec_s64;
  test_dec_u32;
end.

{
  $Log: tincdec.pp,v $
  Revision 1.1  2002/09/15 17:05:35  carl
    * inc/dec system unit tests

}

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