mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-02 00:42:35 +02:00
307 lines
8.2 KiB
ObjectPascal
307 lines
8.2 KiB
ObjectPascal
{***********************************************************}
|
|
{ CODE GENERATOR TEST SUITE *}
|
|
{***********************************************************}
|
|
{ NODE TESTED : secondshlshr() *}
|
|
{***********************************************************}
|
|
{ PRE-REQUISITES: secondload() }
|
|
{ secondassign() }
|
|
{ secondtypeconv() }
|
|
{ secondinline() with strings only! }
|
|
{ secondadd() comparison }
|
|
{ secondifn() }
|
|
{***********************************************************}
|
|
{ DEFINES : FPC if target is Free Pascal compiler }
|
|
{***********************************************************}
|
|
{ REMARKS: None }
|
|
{***********************************************************}
|
|
Program tshlshr;
|
|
|
|
{----------------------------------------------------}
|
|
{ Cases to test: }
|
|
{ RIGHT NODE (shift count value) }
|
|
{ - LOC_CREGISTER }
|
|
{ - LOC_REFERENCE / LOC_MEM }
|
|
{ - LOC_REGISTER }
|
|
{ - numeric constant }
|
|
{ LEFT NODE (value to shift) }
|
|
{ - LOC_CREGISTER }
|
|
{ - LOC_REFERENCE / LOC_MEM }
|
|
{ - LOC_REGISTER }
|
|
{----------------------------------------------------}
|
|
procedure test(value, required: longint);
|
|
begin
|
|
if value <> required then
|
|
begin
|
|
writeln('Got ',value,' instead of ',required);
|
|
halt(1);
|
|
end
|
|
else
|
|
writeln('Passed!');
|
|
end;
|
|
|
|
|
|
var
|
|
longres : longint;
|
|
longcnt : longint;
|
|
bytecnt : shortint;
|
|
byteres : shortint;
|
|
{$IFDEF FPC}
|
|
int64res : int64;
|
|
int64cnt : int64;
|
|
{$ENDIF}
|
|
Begin
|
|
WriteLn('------------------------------ LONGINT --------------------------------');
|
|
{ left : LOC_REFERENCE }
|
|
{ right : numeric constant }
|
|
WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
|
|
longres:=1;
|
|
longres := longres shl 15;
|
|
Write('(SHL) Value should be 32768...');
|
|
test(longres, 32768);
|
|
|
|
longres:=-1;
|
|
longres := longres shl 15;
|
|
Write('(SHL) Value should be -32768...');
|
|
test(longres, -32768);
|
|
|
|
longres:=1;
|
|
longres := longres shl 33;
|
|
Write('(SHL) Value should be 2...');
|
|
test(longres, 2);
|
|
|
|
longres:=$8000;
|
|
longres := longres shr 15;
|
|
Write('(SHR) Value should be 1...');
|
|
test(longres, 1);
|
|
|
|
longres:=-1;
|
|
longres := longres shr 15;
|
|
Write('(SHR) Value should be 131071...');
|
|
test(longres, 131071);
|
|
|
|
longres:=$FFFF;
|
|
longres := longres shr 33;
|
|
Write('(SHR) Value should be 32767...');
|
|
test(longres, 32767);
|
|
|
|
{ left : LOC_REFERENCE }
|
|
{ right : LOC_REFERENCE }
|
|
WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
|
|
|
|
longres := 1;
|
|
longcnt := -2;
|
|
longres:=longres shl longcnt ;
|
|
Write('(SHL) Value should be 1073741824...');
|
|
test(longres, 1073741824);
|
|
|
|
longres:=1;
|
|
longcnt:=15;
|
|
longres := longres shl longcnt;
|
|
Write('(SHL) Value should be 32768...');
|
|
test(longres, 32768);
|
|
|
|
longres:=-1;
|
|
longcnt := 15;
|
|
longres := longres shl longcnt;
|
|
Write('(SHL) Value should be -32768...');
|
|
test(longres, -32768);
|
|
|
|
longres := 1;
|
|
longcnt := -2;
|
|
longres:=longres shr longcnt ;
|
|
Write('(SHR) Value should be 0...');
|
|
test(longres, 0);
|
|
|
|
longres:=32768;
|
|
longcnt:=15;
|
|
longres := longres shr longcnt;
|
|
Write('(SHR) Value should be 1...');
|
|
test(longres, 1);
|
|
|
|
longres:=-1;
|
|
longcnt := 15;
|
|
longres := longres shl longcnt;
|
|
Write('(SHR) Value should be -32768...');
|
|
test(longres, -32768);
|
|
|
|
{ left : LOC_REFERENCE }
|
|
{ right : LOC_REGISRER }
|
|
WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
|
|
longres := 1;
|
|
bytecnt := -2;
|
|
longres:=longres shl bytecnt ;
|
|
Write('(SHL) Value should be 1073741824...');
|
|
test(longres, 1073741824);
|
|
|
|
longres:=1;
|
|
bytecnt:=15;
|
|
longres := longres shl bytecnt;
|
|
Write('(SHL) Value should be 32768...');
|
|
test(longres, 32768);
|
|
|
|
longres:=-1;
|
|
bytecnt := 15;
|
|
longres := longres shl bytecnt;
|
|
Write('(SHL) Value should be -32768...');
|
|
test(longres, -32768);
|
|
|
|
longres := 1;
|
|
bytecnt := -2;
|
|
longres:=longres shr bytecnt ;
|
|
Write('(SHR) Value should be 0...');
|
|
test(longres, 0);
|
|
|
|
longres:=32768;
|
|
bytecnt:=15;
|
|
longres := longres shr bytecnt;
|
|
Write('(SHR) Value should be 1...');
|
|
test(longres, 1);
|
|
|
|
longres:=-1;
|
|
bytecnt := 15;
|
|
longres := longres shr bytecnt;
|
|
Write('(SHR) Value should be 131071...');
|
|
test(longres, 131071);
|
|
|
|
WriteLn('(left) : LOC_REGISTER; (right) : LOC_REGISTER');
|
|
byteres := 1;
|
|
bytecnt := 2;
|
|
byteres := byteres shl bytecnt;
|
|
Write('(SHL) Value should be 4...');
|
|
test(byteres, 4);
|
|
|
|
|
|
byteres := 4;
|
|
bytecnt := 2;
|
|
byteres := byteres shr bytecnt;
|
|
Write('(SHR) Value should be 1...');
|
|
test(byteres, 1);
|
|
|
|
{$IFDEF FPC}
|
|
WriteLn('------------------------------ INT64 --------------------------------');
|
|
{ left : LOC_REFERENCE }
|
|
{ right : numeric constant }
|
|
WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
|
|
int64res:=1;
|
|
int64res := int64res shl 15;
|
|
Write('(SHL) Value should be 32768...');
|
|
test(int64res and $FFFFFFFF, 32768);
|
|
|
|
int64res:=-1;
|
|
int64res := int64res shl 15;
|
|
Write('(SHL) Value should be -32768...');
|
|
test(int64res and $FFFFFFFF, -32768);
|
|
|
|
|
|
int64res:=1;
|
|
int64res := int64res shl 65;
|
|
Write('(SHL) Value should be 0...');
|
|
test(int64res and $FFFFFFFF, 0);
|
|
|
|
int64res:=$8000;
|
|
int64res := int64res shr 15;
|
|
Write('(SHR) Value should be 1...');
|
|
test(int64res and $FFFFFFFF, 1);
|
|
|
|
{ int64res:=-1;
|
|
int64res := int64res shr 15;
|
|
Write('(SHR) Value should be 131071...');}
|
|
int64res:=$FFFF;
|
|
int64res := int64res shr 65;
|
|
Write('(SHR) Value should be 0...');
|
|
test(int64res and $FFFFFFFF, 0);
|
|
|
|
{ left : LOC_REFERENCE }
|
|
{ right : LOC_REFERENCE }
|
|
WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
|
|
int64res := 1;
|
|
int64cnt := -2;
|
|
int64res:=int64res shl int64cnt ;
|
|
Write('(SHL) Value should be 1073741824...');
|
|
test(int64res and $FFFFFFFF, 1073741824);
|
|
|
|
int64res:=1;
|
|
int64cnt:=15;
|
|
int64res := int64res shl int64cnt;
|
|
Write('(SHL) Value should be 32768...');
|
|
test(int64res and $FFFFFFFF, 32768);
|
|
|
|
|
|
int64res:=-1;
|
|
int64cnt := 15;
|
|
int64res := int64res shl int64cnt;
|
|
Write('(SHL) Value should be -32768...');
|
|
test(int64res and $FFFFFFFF, -32768);
|
|
|
|
|
|
int64res := 1;
|
|
int64cnt := -2;
|
|
int64res:=int64res shr int64cnt ;
|
|
Write('(SHR) Value should be 0...');
|
|
test(int64res and $FFFFFFFF, 0);
|
|
|
|
int64res:=32768;
|
|
int64cnt:=15;
|
|
int64res := int64res shr int64cnt;
|
|
Write('(SHR) Value should be 1...');
|
|
test(int64res and $FFFFFFFF, 1);
|
|
|
|
int64res:=-1;
|
|
int64cnt := 15;
|
|
int64res := int64res shl int64cnt;
|
|
Write('(SHR) Value should be -32768...');
|
|
test(int64res and $FFFFFFFF, -32768);
|
|
|
|
{ left : LOC_REFERENCE }
|
|
{ right : LOC_REGISRER }
|
|
WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
|
|
int64res := 1;
|
|
bytecnt := -2;
|
|
int64res:=int64res shl bytecnt ;
|
|
Write('(SHL) Value should be 1073741824...');
|
|
test(int64res and $FFFFFFFF, 1073741824);
|
|
|
|
|
|
int64res:=1;
|
|
bytecnt:=15;
|
|
int64res := int64res shl bytecnt;
|
|
Write('(SHL) Value should be 32768...');
|
|
test(int64res and $FFFFFFFF, 32768);
|
|
|
|
|
|
int64res:=-1;
|
|
bytecnt := 15;
|
|
int64res := int64res shl bytecnt;
|
|
Write('(SHL) Value should be -32768...');
|
|
test(int64res and $FFFFFFFF, -32768);
|
|
|
|
|
|
int64res := 1;
|
|
bytecnt := -2;
|
|
int64res:=int64res shr bytecnt ;
|
|
Write('(SHR) Value should be 0...');
|
|
test(int64res and $FFFFFFFF, 0);
|
|
|
|
|
|
int64res:=32768;
|
|
bytecnt:=15;
|
|
int64res := int64res shr bytecnt;
|
|
Write('(SHR) Value should be 1...');
|
|
test(int64res and $FFFFFFFF, 1);
|
|
{ int64res:=-1;
|
|
bytecnt := 15;
|
|
int64res := int64res shr bytecnt;
|
|
WriteLn('(SHR) Value should be 131071...',int64res);}
|
|
|
|
{$ENDIF}
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.4 2002-03-29 18:43:55 peter
|
|
* updated int64 tests so kylix passes the tests
|
|
|
|
Revision 1.3 2002/03/05 21:56:32 carl
|
|
* Adapted for automated testing
|
|
|
|
} |