freepascal.compiler/tests/test/cg/tshlshr.pp

{***********************************************************}
{ 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;

type
tint64record = packed record
{$ifdef ENDIAN_BIG}
   highval : longint;
   lowval  : longint;
{$else}
   lowval  : longint;
   highval : longint;
{$endif}
end;


var
 longres :  longint;
 longcnt : longint;
 bytecnt : shortint;
 byteres : shortint;
{$IFDEF FPC}
 int64res : int64;
 int64cnt : int64;
 int64rec : tint64record;
{$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:=$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 := 33;
   int64res := int64res shl int64cnt;
   Write('(SHL) Value should be 2 in high longint (85899345)...');
   move(int64res,int64rec, sizeof(int64));
   test(int64rec.highval, 2);
{   test(int64res, 8589934592);}


   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 := 33;
   int64res := int64res shl bytecnt;
   Write('(SHL) Value should be 2 in high longint (85899345)...');
   move(int64res,int64rec, sizeof(int64));
   test(int64rec.highval, 2);
   
{   int64res:=-1;
   bytecnt := 15;
   int64res := int64res shr bytecnt;
   WriteLn('(SHR) Value should be 131071...',int64res);}

{$ENDIF}
end.

{
  $Log$
  Revision 1.6  2002-09-29 14:37:22  carl
    * must more 64-bit testing (to detect endian specific problems)

  Revision 1.5  2002/09/07 15:40:56  peter
    * old logs removed and tabs fixed

  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

}