paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 09:59:40 +02:00
Code Issues Packages Projects Releases Wiki Activity
main
fpc/tests/test/cg/tsar1.pp
florian f8bf268406 * handle sarX(<const>,<var>) properly. resolves #15653 
git-svn-id: trunk@14866 -
2010-02-04 21:30:25 +00:00

542 lines
10 KiB
ObjectPascal
Raw Permalink Blame History

program tsar1;
{$mode objfpc}
{$o-}
var
c0,c4,c7,c15,c31,c63,c36,c20,c68,c12 : integer;
c3f : shortint;
c3fff : smallint;
c3fffffff : longint;
c3fffffffffffffff : int64;
begin
c0:=0;
c4:=4;
c7:=7;
c15:=15;
c31:=31;
c63:=63;
c36:=36;
c20:=20;
c68:=68;
c12:=12;
c3f:=$3f;
c3fff:=$3fff;
c3fffffff:=$3fffffff;
c3fffffffffffffff:=$3fffffffffffffff;
writeln('Testing constant SarInt64...');
if SarInt64(-$3FFFFFFFFFFFFFFF,4)<>-$400000000000000 then begin
writeln('Fail!');
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF,4)<>$3FFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFF0,4)<>-$3FFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFF0,4)<>$3FFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFFF,0)<>-$3FFFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF,0)<>$3FFFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFFF,63)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF,63)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFFF)<>-$2000000000000000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF)<>$1FFFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing constant SarLongint...');
if SarLongint(-$3FFFFFFF,4)<>-$4000000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF,4)<>$3FFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFF0,4)<>-$3FFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFF0,4)<>$3FFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFFF,0)<>-$3FFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF,0)<>$3FFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFFF,31)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF,31)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFFF)<>-$20000000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF)<>$1FFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing constant SarSmallint...');
if SarSmallint(-$3FFF,4)<>-$400 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF,4)<>$3FF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FF0,4)<>-$3FF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FF0,4)<>$3FF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FFF,0)<>-$3FFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF,0)<>$3FFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FFF,15)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF,15)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FFF)<>-$2000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF)<>$1FFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing constant SarShortint...');
if SarShortint(-$3F,4)<>-$4 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F,4)<>$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$30,4)<>-$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($30,4)<>$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$3F,0)<>-$3F then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F,0)<>$3F then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$3F,7)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F,7)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$3F)<>-$20 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F)<>$1F then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing constant shifting overflows');
if SarInt64($3fffffffffffffff,68)<>$3ffffffffffffff then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3fffffff,36)<>$3ffffff then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3fff,20)<>$3ff then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3f,12)<>$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing SarInt64...');
if SarInt64(-$3FFFFFFFFFFFFFFF,c4)<>-$400000000000000 then begin
writeln('Fail!');
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF,c4)<>$3FFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFF0,c4)<>-$3FFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFF0,c4)<>$3FFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFFF,c0)<>-$3FFFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF,c0)<>$3FFFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFFF,c63)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF,c63)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-c3FFFFFFFFFFFFFFF,63)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(c3FFFFFFFFFFFFFFF,63)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64(-$3FFFFFFFFFFFFFFF)<>-$2000000000000000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarInt64($3FFFFFFFFFFFFFFF)<>$1FFFFFFFFFFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing SarLongint...');
if SarLongint(-$3FFFFFFF,c4)<>-$4000000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF,c4)<>$3FFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFF0,c4)<>-$3FFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFF0,c4)<>$3FFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFFF,c0)<>-$3FFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF,c0)<>$3FFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFFF,c31)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF,c31)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-c3FFFFFFF,31)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(c3FFFFFFF,31)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint(-$3FFFFFFF)<>-$20000000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3FFFFFFF)<>$1FFFFFFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing SarSmallint...');
if SarSmallint(-$3FFF,c4)<>-$400 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF,c4)<>$3FF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FF0,c4)<>-$3FF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FF0,c4)<>$3FF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FFF,c0)<>-$3FFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF,c0)<>$3FFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FFF,c15)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF,c15)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-c3FFF,15)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(c3FFF,15)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint(-$3FFF)<>-$2000 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3FFF)<>$1FFF then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
writeln('Testing SarShortint...');
if SarShortint(-$3F,c4)<>-$4 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F,c4)<>$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$30,c4)<>-$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($30,c4)<>$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$3F,c0)<>-$3F then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F,c0)<>$3F then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$3F,c7)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(c3F,7)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-c3F,7)<>-1 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F,c7)<>0 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint(-$3F)<>-$20 then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3F)<>$1F then begin
halt(1);
end else begin
writeln('Pass!');
end;
writeln;
{ the overflow behaviour is different for different CPUs
writeln('Testing shifting overflows');
if SarInt64($3fffffffffffffff,c68)<>$3ffffffffffffff then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarLongint($3fffffff,c36)<>$3ffffff then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarSmallint($3fff,c20)<>$3ff then begin
halt(1);
end else begin
writeln('Pass!');
end;
if SarShortint($3f,c12)<>$3 then begin
halt(1);
end else begin
writeln('Pass!');
end;
}
writeln('All passed');
end.
Reference in New Issue View Git Blame Copy Permalink