1! Test the SHIFTA, SHIFTL and SHIFTR intrinsics. 2! 3! { dg-do run } 4! { dg-options "-ffree-line-length-none" } 5! { dg-require-effective-target fortran_integer_16 } 6 7 implicit none 8 9#define CHECK(I,SHIFT,RESA,RESL,RESR) \ 10 if (shifta(I,SHIFT) /= RESA) STOP 1; \ 11 if (shiftr(I,SHIFT) /= RESR) STOP 2; \ 12 if (shiftl(I,SHIFT) /= RESL) STOP 3; \ 13 if (run_shifta(I,SHIFT) /= RESA) STOP 4; \ 14 if (run_shiftr(I,SHIFT) /= RESR) STOP 5; \ 15 if (run_shiftl(I,SHIFT) /= RESL) STOP 6; \ 16 if (ishft(I,SHIFT) /= RESL) STOP 7; \ 17 if (ishft(I,-SHIFT) /= RESR) STOP 8; \ 18 if (run_ishft(I,SHIFT) /= RESL) STOP 9; \ 19 if (run_ishft(I,-SHIFT) /= RESR) STOP 10 20 21 CHECK(0_16,0,0_16,0_16,0_16) 22 CHECK(11_16,0,11_16,11_16,11_16) 23 CHECK(-11_16,0,-11_16,-11_16,-11_16) 24 CHECK(0_16,1,0_16,0_16,0_16) 25 CHECK(11_16,1,5_16,22_16,5_16) 26 CHECK(11_16,2,2_16,44_16,2_16) 27 CHECK(-11_16,1,-6_16,-22_16,huge(0_16)-5_16) 28 29contains 30 31 function run_shifta (i, shift) result(res) 32 integer(kind=16) :: i, res 33 integer :: shift 34 res = shifta(i,shift) 35 end function 36 function run_shiftl (i, shift) result(res) 37 integer(kind=16) :: i, res 38 integer :: shift 39 res = shiftl(i,shift) 40 end function 41 function run_shiftr (i, shift) result(res) 42 integer(kind=16) :: i, res 43 integer :: shift 44 res = shiftr(i,shift) 45 end function 46 function run_ishft (i, shift) result(res) 47 integer(kind=16) :: i, res 48 integer :: shift 49 res = ishft(i,shift) 50 end function 51 52end 53