+ int_int type conversion tests

tests/test/cg/tcnvint3.pp

@@ -0,0 +1,415 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondtypeconvert() -> second_int_to_int         }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondcalln()                                  }
+{                 secondinline()                                 }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{****************************************************************}
+{ REMARKS:                                                       }
+{****************************************************************}
+program tcnvint3;
+
+{$R-}
+
+{$ifndef fpc}
+type
+  smallint = integer;
+{$endif}
+
+procedure fail;
+begin
+  WriteLn('Failure.');
+  halt(1);
+end;
+
+
+const
+ ABSOLUTE_GETS8BIT_RESULT    = 63;
+ GETS8BIT_RESULT             = -63;
+ GETU8BIT_RESULT             = $55; 
+ ABSOLUTE_GETS16BIT_RESULT   = 16384;
+ GETS16BIT_RESULT            = -16384;
+ GETU16BIT_RESULT            = 32767;
+ GETS32BIT_RESULT            = -1000000;
+ GETU32BIT_RESULT            =  2000000;
+
+
+{$ifdef fpc}
+   function gets64bit : int64;
+    begin
+      gets64bit := 12;
+    end;
+{$endif}
+
+   function gets32bit : longint;
+    begin
+      gets32bit := GETS32BIT_RESULT;    
+    end;
+    
+  
+  { return an 8-bit signed value }
+  function gets8bit : shortint;
+    begin
+      gets8bit := GETS8BIT_RESULT;
+    end;
+   
+  { return an 8-bit unsigned value }
+  function getu8bit : byte;
+   begin
+     getu8bit := GETU8BIT_RESULT;
+   end;
+   
+   
+  function gets16bit : smallint;
+    begin
+      gets16bit := GETS16BIT_RESULT;
+    end;
+    
+  function getu16bit : word;
+    begin
+      getu16bit := GETU16BIT_RESULT;
+    end;
+  
+
+   function getu32bit : longint;
+    begin
+      getu32bit := GETU32BIT_RESULT;
+    end;
+
+var
+ s8bit : shortint;
+ s16bit : smallint;
+ s32bit : longint;
+ u16bit : word;
+ u8bit : byte;
+ failed : boolean;
+{$ifdef fpc}
+ s64bit : int64;
+ u32bit : cardinal;
+{$endif}
+begin
+  {--------------------- dst_size < src_size -----------------------}
+  { Actually the destination is always a natural register  }
+  { either 32-bit / 64-bit, therefore not really important }
+  { to do extensive checking on these nodes.               }
+  { src : LOC_REGISTER }
+  { dst : LOC_REGISTER }
+  writeln('type conversion src_size > dst_size');
+  writeln('dst : LOC_REGISTER src : LOC_REGISTER ');
+{$ifdef fpc}
+  write('Testing dst : s32bit src : s64bit...');
+  { s64bit -> s32bit  }
+  s32bit:=gets64bit;
+  if s32bit <> 12 then
+    Fail
+  else
+    WriteLn('Passed.');
+  { s64bit -> s8bit }
+  write('Testing dst : s8bit src : s64bit...');
+  s8bit:=gets64bit;
+  if s8bit <> 12 then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+  { s32bit -> s16bit }
+  write('Testing dst : s16bit src : s32bit...');
+  s16bit := gets32bit;
+  if s16bit <> smallint(GETS32BIT_RESULT AND $FFFF) then
+    Fail
+  else
+    WriteLn('Passed.');
+
+  { Here we will check each possible case of src, to test also the load }
+  { of different memory sizes cases.                                    }
+  { src : LOC_REFERENCE }
+  { dst : LOC_REGISTER  }
+{$ifdef fpc}
+  writeln('dst : LOC_REGISTER src : LOC_REFERENCE ');
+  write('Testing dst : s32bit src : s64bit...');
+  s64bit:=$FF0000;
+  s32bit:=s64bit;
+  if s32bit <> $FF0000 then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+  write('Testing dst : s16bit src : s32bit...');
+  s32bit:=$FF00;
+  s16bit:=s32bit;
+  if s16bit <> smallint($FF00) then
+    Fail
+  else
+    WriteLn('Passed.');
+  { try a signed value }
+  write('Testing dst : s16bit src : s32bit...');
+  s32bit:=-14;
+  s16bit:=s32bit;
+  if s16bit <> smallint(-14) then
+    Fail
+  else
+    WriteLn('Passed.');
+  s16bit:=$FF;
+  write('Testing dst : s8bit src : s16bit...');
+  s8bit:=s16bit;
+  if s8bit <> shortint($FF) then
+    Fail
+  else
+    WriteLn('Passed.');
+{$ifdef fpc}
+  write('Testing dst : u16bit src : u32bit...');
+  u32bit:=$F001;
+  u16bit := u32bit;
+  if u16bit <> $F001 then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+  write('Testing dst : u8bit src : u16bit...');
+  u16bit := $10;
+  u8bit := u16bit;
+  if u8bit <> $10 then
+    Fail
+  else
+    WriteLn('Passed.');
+    
+  { That was the easy part... now : dst_size > src_size    }
+  { here we must take care of sign extension               }
+  
+  { src : LOC_REGISTER }
+  { dst : LOC_REGISTER }
+  writeln('type conversion dst_size > src_size');
+  writeln('dst : LOC_REGISTER src : LOC_REGISTER ');
+
+  failed := false;
+  write('Testing dst : u16bit  src : s8bit, u8bit... ');
+  u16bit:=gets8bit;
+  if u16bit <> word(GETS8BIT_RESULT) then
+     failed := true;
+  u16bit:=getu8bit;
+  if u16bit <> GETU8BIT_RESULT then
+     failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+
+{$ifdef fpc}
+  failed := false;
+  write('Testing dst : u32bit  src : s8bit, u8bit, s16bit, u16bit... ');
+  u32bit:=gets8bit;
+  if u32bit <> cardinal(GETS8BIT_RESULT) then
+     failed := true;
+  u32bit:=getu8bit;
+  if u32bit <> GETU8BIT_RESULT then
+     failed := true;
+  u32bit:=gets16bit;
+  if u32bit <> cardinal(GETS16BIT_RESULT) then
+     failed := true;
+  u32bit:=getu16bit;
+  if u32bit <> GETU16BIT_RESULT then
+     failed := true;
+
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+
+
+  failed := false;
+  write('Testing dst : s16bit  src : s8bit, u8bit...');
+  s16bit := gets8bit;
+  if s16bit <> GETS8BIT_RESULT then
+    failed := true;
+  s16bit := getu8bit;
+  if s16bit <> GETU8BIT_RESULT then
+    failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+  
+
+  failed := false;
+  write('Testing dst : s32bit  src : s8bit, u8bit. s16bit, u16bit...');
+
+  s32bit := gets8bit;
+  if s32bit <> GETS8BIT_RESULT then
+    failed := true;
+  s32bit := getu8bit;
+  if s32bit <> GETU8BIT_RESULT then
+    failed := true;
+  s32bit := gets16bit;
+  if s32bit <> GETS16BIT_RESULT then
+    failed := true;
+  s32bit := getu16bit;
+  if s32bit <> GETU16BIT_RESULT then
+    failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+  
+{$ifdef fpc}
+  failed := false;
+  write('Testing dst : s64bit  src : s8bit, u8bit. s16bit, u16bit, s32bit, u32bit...');
+
+  s64bit := gets8bit;
+  if s64bit <> GETS8BIT_RESULT then
+    failed := true;
+  s64bit := getu8bit;
+  if s64bit <> GETU8BIT_RESULT then
+    failed := true;
+  s64bit := gets16bit;
+  if s64bit <> GETS16BIT_RESULT then
+    failed := true;
+  s64bit := getu16bit;
+  if s64bit <> GETU16BIT_RESULT then
+    failed := true;
+  s64bit := gets32bit;
+  if s64bit <> GETS32BIT_RESULT then
+    failed := true;
+  s64bit := getu32bit;
+  if s64bit <> GETU32BIT_RESULT then
+    failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+  { src : LOC_REFERENCE }
+  { dst : LOC_REGISTER }
+  writeln('type conversion dst_size > src_size');
+  writeln('dst : LOC_REGISTER src : LOC_REFERENCE ');
+
+  failed := false;
+  write('Testing dst : u16bit  src : s8bit, u8bit... ');
+  s8bit := GETS8BIT_RESULT;
+  u16bit:=s8bit;
+  if u16bit <> word(GETS8BIT_RESULT) then
+     failed := true;
+  u8bit := GETU8BIT_RESULT;
+  u16bit:=u8bit;
+  if u16bit <> GETU8BIT_RESULT then
+     failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+
+{$ifdef fpc}
+  failed := false;
+  write('Testing dst : u32bit  src : s8bit, u8bit, s16bit, u16bit... ');
+  s8bit := GETS8BIT_RESULT;
+  u32bit:=s8bit;
+  if u32bit <> cardinal(GETS8BIT_RESULT) then
+     failed := true;
+  u8bit := GETU8BIT_RESULT;
+  u32bit:=u8bit;
+  if u32bit <> GETU8BIT_RESULT then
+     failed := true;
+  s16bit := GETS16BIT_RESULT;
+  u32bit:=s16bit;
+  if u32bit <> cardinal(GETS16BIT_RESULT) then
+     failed := true;
+  u16bit := GETU16BIT_RESULT;
+  u32bit:=u16bit;
+  if u32bit <> GETU16BIT_RESULT then
+     failed := true;
+
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+
+  failed := false;
+  write('Testing dst : s16bit  src : s8bit, u8bit...');
+  s8bit := GETS8BIT_RESULT;
+  s16bit := s8bit;
+  if s16bit <> GETS8BIT_RESULT then
+    failed := true;
+  u8bit := GETU8BIT_RESULT;
+  s16bit := u8bit;
+  if s16bit <> GETU8BIT_RESULT then
+    failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+
+
+  failed := false;
+  write('Testing dst : s32bit  src : s8bit, u8bit. s16bit, u16bit...');
+  
+  s8bit := GETS8BIT_RESULT;
+  s32bit := s8bit;
+  if s32bit <> GETS8BIT_RESULT then
+    failed := true;
+  u8bit := GETU8BIT_RESULT;
+  s32bit := u8bit;
+  if s32bit <> GETU8BIT_RESULT then
+    failed := true;
+  s16bit := GETS16BIT_RESULT;
+  s32bit := s16bit;
+  if s32bit <> GETS16BIT_RESULT then
+    failed := true;
+  u16bit := GETU16BIT_RESULT;
+  s32bit := u16bit;
+  if s32bit <> GETU16BIT_RESULT then
+    failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+
+
+{$ifdef fpc}
+  failed := false;
+  write('Testing dst : s64bit  src : s8bit, u8bit. s16bit, u16bit, s32bit, u32bit...');
+  
+  s8bit := GETS8BIT_RESULT;
+  s64bit := s8bit;
+  if s64bit <> GETS8BIT_RESULT then
+    failed := true;
+  u8bit := GETU8BIT_RESULT;
+  s64bit := u8bit;
+  if s64bit <> GETU8BIT_RESULT then
+    failed := true;
+  s16bit := GETS16BIT_RESULT;
+  s64bit := s16bit;
+  if s64bit <> GETS16BIT_RESULT then
+    failed := true;
+  u16bit := GETU16BIT_RESULT;
+  s64bit := u16bit;
+  if s64bit <> GETU16BIT_RESULT then
+    failed := true;
+  s32bit := GETS32BIT_RESULT;
+  s64bit := s32bit;
+  if s64bit <> GETS32BIT_RESULT then
+    failed := true;
+  u32bit := GETU32BIT_RESULT;
+  s64bit := u32bit;
+  if s64bit <> GETU32BIT_RESULT then
+    failed := true;
+  if failed then
+    Fail
+  else
+    WriteLn('Passed.');
+{$endif}
+end.
+
+{
+
+ $Log$
+ Revision 1.1  2002-03-18 20:20:13  carl
+ + int_int type conversion tests
+
+}