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

Test run data :

Free Pascal Compiler Test Suite Results

View Test suite results

Please specify search criteria:
File:
Operating system:
Processor:
Version
Date
Submitter
Machine
Comment
Limit
Cond
Category
Only failed tests
Hide skipped tests
List all 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:

Record count: 50

Total = 50

OK=50 Percentage= 100.00

Result type Cat. Count Percentage First date Last Date
Successfully run 50 100.0 2024/05/20 12:23:00 37 2024/05/20 23:23:00 25
i386 14 28.0 2024/05/20 16:23:00 44 2024/05/20 23:23:00 25
m68k 1 2.0 2024/05/20 22:44:00 190 2024/05/20 22:44:00 190
powerpc 1 2.0 2024/05/20 23:05:00 185 2024/05/20 23:05:00 185
arm 1 2.0 2024/05/20 22:30:00 59 2024/05/20 22:30:00 59
x86_64 13 26.0 2024/05/20 13:38:00 23 2024/05/20 19:35:00 26
powerpc64 2 4.0 2024/05/20 23:13:00 213 2024/05/20 23:20:00 71
mips 3 6.0 2024/05/20 12:35:00 35 2024/05/20 22:51:00 240
mipsel 1 2.0 2024/05/20 22:58:00 148 2024/05/20 22:58:00 148
aarch64 14 28.0 2024/05/20 12:23:00 37 2024/05/20 22:24:00 44
linux 12 24.0 2024/05/20 12:23:00 37 2024/05/20 23:20:00 71
solaris 13 26.0 2024/05/20 16:23:00 44 2024/05/20 23:23:00 25
darwin 12 24.0 2024/05/20 16:20:00 32 2024/05/20 17:50:00 56
win64 13 26.0 2024/05/20 13:38:00 23 2024/05/20 19:35:00 26
3.3.1 9 18.0 2024/05/20 12:35:00 35 2024/05/20 23:23:00 25
3.2.2 12 24.0 2024/05/20 16:23:00 44 2024/05/20 17:30:00 45
3.2.3 29 58.0 2024/05/20 12:23:00 37 2024/05/20 23:20:00 71

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.