1! Test the BGE, BGT, BLE and BLT intrinsics. 2! 3! { dg-do run } 4! { dg-options "-ffree-line-length-none" } 5 6 interface run_bge 7 procedure run_bge1 8 procedure run_bge2 9 procedure run_bge4 10 procedure run_bge8 11 end interface 12 13 interface run_bgt 14 procedure run_bgt1 15 procedure run_bgt2 16 procedure run_bgt4 17 procedure run_bgt8 18 end interface 19 20 interface run_ble 21 procedure run_ble1 22 procedure run_ble2 23 procedure run_ble4 24 procedure run_ble8 25 end interface 26 27 interface run_blt 28 procedure run_blt1 29 procedure run_blt2 30 procedure run_blt4 31 procedure run_blt8 32 end interface 33 34#define CHECK(I,J,RES) \ 35 if (bge(I,J) .neqv. RES) call abort ; \ 36 if (run_bge(I,J) .neqv. RES) call abort ; \ 37 if (bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \ 38 if (run_bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \ 39 if (ble(J,I) .neqv. RES) call abort ; \ 40 if (run_ble(J,I) .neqv. RES) call abort ; \ 41 if (blt(J,I) .neqv. (RES .and. (I/=J))) call abort ; \ 42 if (run_blt(J,I) .neqv. (RES .and. (I/=J))) call abort 43 44#define T .true. 45#define F .false. 46 47 CHECK(0_1, 0_1, T) 48 CHECK(1_1, 0_1, T) 49 CHECK(0_1, 107_1, F) 50 CHECK(5_1, huge(0_1) / 2_1, F) 51 CHECK(5_1, huge(0_1), F) 52 CHECK(-1_1, 0_1, T) 53 CHECK(0_1, -19_1, F) 54 CHECK(huge(0_1), -19_1, F) 55 56 CHECK(0_2, 0_2, T) 57 CHECK(1_2, 0_2, T) 58 CHECK(0_2, 107_2, F) 59 CHECK(5_2, huge(0_2) / 2_2, F) 60 CHECK(5_2, huge(0_2), F) 61 CHECK(-1_2, 0_2, T) 62 CHECK(0_2, -19_2, F) 63 CHECK(huge(0_2), -19_2, F) 64 65 CHECK(0_4, 0_4, T) 66 CHECK(1_4, 0_4, T) 67 CHECK(0_4, 107_4, F) 68 CHECK(5_4, huge(0_4) / 2_4, F) 69 CHECK(5_4, huge(0_4), F) 70 CHECK(-1_4, 0_4, T) 71 CHECK(0_4, -19_4, F) 72 CHECK(huge(0_4), -19_4, F) 73 74 CHECK(0_8, 0_8, T) 75 CHECK(1_8, 0_8, T) 76 CHECK(0_8, 107_8, F) 77 CHECK(5_8, huge(0_8) / 2_8, F) 78 CHECK(5_8, huge(0_8), F) 79 CHECK(-1_8, 0_8, T) 80 CHECK(0_8, -19_8, F) 81 CHECK(huge(0_8), -19_8, F) 82 83contains 84 85 pure logical function run_bge1 (i, j) result(res) 86 integer(kind=1), intent(in) :: i, j 87 res = bge(i,j) 88 end function 89 pure logical function run_bgt1 (i, j) result(res) 90 integer(kind=1), intent(in) :: i, j 91 res = bgt(i,j) 92 end function 93 pure logical function run_ble1 (i, j) result(res) 94 integer(kind=1), intent(in) :: i, j 95 res = ble(i,j) 96 end function 97 pure logical function run_blt1 (i, j) result(res) 98 integer(kind=1), intent(in) :: i, j 99 res = blt(i,j) 100 end function 101 102 pure logical function run_bge2 (i, j) result(res) 103 integer(kind=2), intent(in) :: i, j 104 res = bge(i,j) 105 end function 106 pure logical function run_bgt2 (i, j) result(res) 107 integer(kind=2), intent(in) :: i, j 108 res = bgt(i,j) 109 end function 110 pure logical function run_ble2 (i, j) result(res) 111 integer(kind=2), intent(in) :: i, j 112 res = ble(i,j) 113 end function 114 pure logical function run_blt2 (i, j) result(res) 115 integer(kind=2), intent(in) :: i, j 116 res = blt(i,j) 117 end function 118 119 pure logical function run_bge4 (i, j) result(res) 120 integer(kind=4), intent(in) :: i, j 121 res = bge(i,j) 122 end function 123 pure logical function run_bgt4 (i, j) result(res) 124 integer(kind=4), intent(in) :: i, j 125 res = bgt(i,j) 126 end function 127 pure logical function run_ble4 (i, j) result(res) 128 integer(kind=4), intent(in) :: i, j 129 res = ble(i,j) 130 end function 131 pure logical function run_blt4 (i, j) result(res) 132 integer(kind=4), intent(in) :: i, j 133 res = blt(i,j) 134 end function 135 136 pure logical function run_bge8 (i, j) result(res) 137 integer(kind=8), intent(in) :: i, j 138 res = bge(i,j) 139 end function 140 pure logical function run_bgt8 (i, j) result(res) 141 integer(kind=8), intent(in) :: i, j 142 res = bgt(i,j) 143 end function 144 pure logical function run_ble8 (i, j) result(res) 145 integer(kind=8), intent(in) :: i, j 146 res = ble(i,j) 147 end function 148 pure logical function run_blt8 (i, j) result(res) 149 integer(kind=8), intent(in) :: i, j 150 res = blt(i,j) 151 end function 152 153end 154