mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 00:42:06 +02:00
414 lines
9.7 KiB
ObjectPascal
414 lines
9.7 KiB
ObjectPascal
{****************************************************************}
|
|
{ CODE GENERATOR TEST PROGRAM }
|
|
{****************************************************************}
|
|
{ NODE TESTED : secondtypeconvert() -> second_int_to_int }
|
|
{****************************************************************}
|
|
{ PRE-REQUISITES: secondload() }
|
|
{ secondassign() }
|
|
{ secondcalln() }
|
|
{ secondinline() }
|
|
{ secondadd() }
|
|
{****************************************************************}
|
|
{ DEFINES: }
|
|
{****************************************************************}
|
|
{ REMARKS: }
|
|
{****************************************************************}
|
|
program tcnvint3;
|
|
|
|
{$ifdef VER70}
|
|
{$define tp}
|
|
{$endif}
|
|
|
|
{$R-}
|
|
|
|
{$ifdef tp}
|
|
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;
|
|
|
|
|
|
{$ifndef tp}
|
|
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;
|
|
|
|
|
|
{$ifndef tp}
|
|
function getu32bit : longword;
|
|
begin
|
|
getu32bit := GETU32BIT_RESULT;
|
|
end;
|
|
{$endif tp}
|
|
|
|
var
|
|
s8bit : shortint;
|
|
s16bit : smallint;
|
|
s32bit : longint;
|
|
u16bit : word;
|
|
u8bit : byte;
|
|
failed : boolean;
|
|
{$ifndef tp}
|
|
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 ');
|
|
{$ifndef tp}
|
|
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 }
|
|
{$ifndef tp}
|
|
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.');
|
|
{$ifndef tp}
|
|
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.');
|
|
|
|
{$ifndef tp}
|
|
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.');
|
|
|
|
{$ifndef tp}
|
|
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.');
|
|
|
|
{$ifndef tp}
|
|
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.');
|
|
|
|
|
|
{$ifndef tp}
|
|
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.
|