mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 09:09:30 +02:00
+ int_int type conversion tests
This commit is contained in:
carl
parent
348ee97023
commit
5a19f7a82a
415
tests/test/cg/tcnvint3.pp
Normal file
415
tests/test/cg/tcnvint3.pp
Normal file
@ -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
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user