| ! Test the SHIFTA, SHIFTL and SHIFTR intrinsics. |
| ! |
| ! { dg-do run } |
| ! { dg-options "-ffree-line-length-none" } |
| |
| interface run_shifta |
| procedure shifta_1 |
| procedure shifta_2 |
| procedure shifta_4 |
| procedure shifta_8 |
| end interface |
| interface run_shiftl |
| procedure shiftl_1 |
| procedure shiftl_2 |
| procedure shiftl_4 |
| procedure shiftl_8 |
| end interface |
| interface run_shiftr |
| procedure shiftr_1 |
| procedure shiftr_2 |
| procedure shiftr_4 |
| procedure shiftr_8 |
| end interface |
| interface run_ishft |
| procedure ishft_1 |
| procedure ishft_2 |
| procedure ishft_4 |
| procedure ishft_8 |
| end interface |
| |
| #define CHECK(I,SHIFT,RESA,RESL,RESR) \ |
| if (shifta(I,SHIFT) /= RESA) STOP 1; \ |
| if (shiftr(I,SHIFT) /= RESR) STOP 2; \ |
| if (shiftl(I,SHIFT) /= RESL) STOP 3; \ |
| if (run_shifta(I,SHIFT) /= RESA) STOP 4; \ |
| if (run_shiftr(I,SHIFT) /= RESR) STOP 5; \ |
| if (run_shiftl(I,SHIFT) /= RESL) STOP 6; \ |
| if (ishft(I,SHIFT) /= RESL) STOP 7; \ |
| if (ishft(I,-SHIFT) /= RESR) STOP 8; \ |
| if (run_ishft(I,SHIFT) /= RESL) STOP 9; \ |
| if (run_ishft(I,-SHIFT) /= RESR) STOP 10 |
| |
| CHECK(0_1,0,0_1,0_1,0_1) |
| CHECK(11_1,0,11_1,11_1,11_1) |
| CHECK(-11_1,0,-11_1,-11_1,-11_1) |
| CHECK(0_1,1,0_1,0_1,0_1) |
| CHECK(11_1,1,5_1,22_1,5_1) |
| CHECK(11_1,2,2_1,44_1,2_1) |
| CHECK(-11_1,1,-6_1,-22_1,huge(0_1)-5_1) |
| |
| CHECK(0_2,0,0_2,0_2,0_2) |
| CHECK(11_2,0,11_2,11_2,11_2) |
| CHECK(-11_2,0,-11_2,-11_2,-11_2) |
| CHECK(0_2,1,0_2,0_2,0_2) |
| CHECK(11_2,1,5_2,22_2,5_2) |
| CHECK(11_2,2,2_2,44_2,2_2) |
| CHECK(-11_2,1,-6_2,-22_2,huge(0_2)-5_2) |
| |
| CHECK(0_4,0,0_4,0_4,0_4) |
| CHECK(11_4,0,11_4,11_4,11_4) |
| CHECK(-11_4,0,-11_4,-11_4,-11_4) |
| CHECK(0_4,1,0_4,0_4,0_4) |
| CHECK(11_4,1,5_4,22_4,5_4) |
| CHECK(11_4,2,2_4,44_4,2_4) |
| CHECK(-11_4,1,-6_4,-22_4,huge(0_4)-5_4) |
| |
| CHECK(0_8,0,0_8,0_8,0_8) |
| CHECK(11_8,0,11_8,11_8,11_8) |
| CHECK(-11_8,0,-11_8,-11_8,-11_8) |
| CHECK(0_8,1,0_8,0_8,0_8) |
| CHECK(11_8,1,5_8,22_8,5_8) |
| CHECK(11_8,2,2_8,44_8,2_8) |
| CHECK(-11_8,1,-6_8,-22_8,huge(0_8)-5_8) |
| |
| contains |
| |
| function shifta_1 (i, shift) result(res) |
| integer(kind=1) :: i, res |
| integer :: shift |
| res = shifta(i,shift) |
| end function |
| function shiftl_1 (i, shift) result(res) |
| integer(kind=1) :: i, res |
| integer :: shift |
| res = shiftl(i,shift) |
| end function |
| function shiftr_1 (i, shift) result(res) |
| integer(kind=1) :: i, res |
| integer :: shift |
| res = shiftr(i,shift) |
| end function |
| |
| function shifta_2 (i, shift) result(res) |
| integer(kind=2) :: i, res |
| integer :: shift |
| res = shifta(i,shift) |
| end function |
| function shiftl_2 (i, shift) result(res) |
| integer(kind=2) :: i, res |
| integer :: shift |
| res = shiftl(i,shift) |
| end function |
| function shiftr_2 (i, shift) result(res) |
| integer(kind=2) :: i, res |
| integer :: shift |
| res = shiftr(i,shift) |
| end function |
| |
| function shifta_4 (i, shift) result(res) |
| integer(kind=4) :: i, res |
| integer :: shift |
| res = shifta(i,shift) |
| end function |
| function shiftl_4 (i, shift) result(res) |
| integer(kind=4) :: i, res |
| integer :: shift |
| res = shiftl(i,shift) |
| end function |
| function shiftr_4 (i, shift) result(res) |
| integer(kind=4) :: i, res |
| integer :: shift |
| res = shiftr(i,shift) |
| end function |
| |
| function shifta_8 (i, shift) result(res) |
| integer(kind=8) :: i, res |
| integer :: shift |
| res = shifta(i,shift) |
| end function |
| function shiftl_8 (i, shift) result(res) |
| integer(kind=8) :: i, res |
| integer :: shift |
| res = shiftl(i,shift) |
| end function |
| function shiftr_8 (i, shift) result(res) |
| integer(kind=8) :: i, res |
| integer :: shift |
| res = shiftr(i,shift) |
| end function |
| |
| function ishft_1 (i, shift) result(res) |
| integer(kind=1) :: i, res |
| integer :: shift |
| res = ishft(i,shift) |
| end function |
| function ishft_2 (i, shift) result(res) |
| integer(kind=2) :: i, res |
| integer :: shift |
| res = ishft(i,shift) |
| end function |
| function ishft_4 (i, shift) result(res) |
| integer(kind=4) :: i, res |
| integer :: shift |
| res = ishft(i,shift) |
| end function |
| function ishft_8 (i, shift) result(res) |
| integer(kind=8) :: i, res |
| integer :: shift |
| res = ishft(i,shift) |
| end function |
| |
| end |