1! { dg-do run } 2! { dg-options "" } 3! Test various exponentations 4! initially designed for patch to PR31120 5 6program test 7 call run_me (1.0, 1, (1.0,0.0)) 8 call run_me (-1.1, -1, (0.0,-1.0)) 9 call run_me (42.0, 12, (1.0,7.0)) 10end program test 11 12! This subroutine is for runtime tests 13subroutine run_me(a, i, z) 14 implicit none 15 16 real, intent(in) :: a 17 integer, intent(in) :: i 18 complex, intent(in) :: z 19 20 call check_equal_i (i**0, 1) 21 call check_equal_i (i**1, i) 22 call check_equal_i (i**2, i*i) 23 call check_equal_i (i**3, i*(i**2)) 24 25 ! i has default integer kind. 26 call check_equal_i (int(i**0_8,kind=kind(i)), 1) 27 call check_equal_i (int(i**1_8,kind=kind(i)), i) 28 call check_equal_i (int(i**2_8,kind=kind(i)), i*i) 29 call check_equal_i (int(i**3_8,kind=kind(i)), i*i*i) 30 31 call check_equal_r (a**0.0, 1.0) 32 call check_equal_r (a**1.0, a) 33 call check_equal_r (a**2.0, a*a) 34 call check_equal_r (a**3.0, a*(a**2)) 35 call check_equal_r (a**(-1.0), 1/a) 36 call check_equal_r (a**(-2.0), (1/a)*(1/a)) 37 38 call check_equal_r (a**0, 1.0) 39 call check_equal_r (a**1, a) 40 call check_equal_r (a**2, a*a) 41 call check_equal_r (a**3, a*(a**2)) 42 call check_equal_r (a**(-1), 1/a) 43 call check_equal_r (a**(-2), (1/a)*(1/a)) 44 45 call check_equal_r (a**0_8, 1.0) 46 call check_equal_r (a**1_8, a) 47 call check_equal_r (a**2_8, a*a) 48 call check_equal_r (a**3_8, a*(a**2)) 49 call check_equal_r (a**(-1_8), 1/a) 50 call check_equal_r (a**(-2_8), (1/a)*(1/a)) 51 52 call check_equal_c (z**0.0, (1.0,0.0)) 53 call check_equal_c (z**1.0, z) 54 call check_equal_c (z**2.0, z*z) 55 call check_equal_c (z**3.0, z*(z**2)) 56 call check_equal_c (z**(-1.0), 1/z) 57 call check_equal_c (z**(-2.0), (1/z)*(1/z)) 58 59 call check_equal_c (z**(0.0,0.0), (1.0,0.0)) 60 call check_equal_c (z**(1.0,0.0), z) 61 call check_equal_c (z**(2.0,0.0), z*z) 62 call check_equal_c (z**(3.0,0.0), z*(z**2)) 63 call check_equal_c (z**(-1.0,0.0), 1/z) 64 call check_equal_c (z**(-2.0,0.0), (1/z)*(1/z)) 65 66 call check_equal_c (z**0, (1.0,0.0)) 67 call check_equal_c (z**1, z) 68 call check_equal_c (z**2, z*z) 69 call check_equal_c (z**3, z*(z**2)) 70 call check_equal_c (z**(-1), 1/z) 71 call check_equal_c (z**(-2), (1/z)*(1/z)) 72 73 call check_equal_c (z**0_8, (1.0,0.0)) 74 call check_equal_c (z**1_8, z) 75 call check_equal_c (z**2_8, z*z) 76 call check_equal_c (z**3_8, z*(z**2)) 77 call check_equal_c (z**(-1_8), 1/z) 78 call check_equal_c (z**(-2_8), (1/z)*(1/z)) 79 80 81contains 82 83 subroutine check_equal_r (a, b) 84 real, intent(in) :: a, b 85 if (abs(a - b) > 1.e-5 * abs(b)) call abort 86 end subroutine check_equal_r 87 88 subroutine check_equal_c (a, b) 89 complex, intent(in) :: a, b 90 if (abs(a - b) > 1.e-5 * abs(b)) call abort 91 end subroutine check_equal_c 92 93 subroutine check_equal_i (a, b) 94 integer, intent(in) :: a, b 95 if (a /= b) call abort 96 end subroutine check_equal_i 97 98end subroutine run_me 99 100! subroutine foo is used for compilation test only 101subroutine foo(a) 102 implicit none 103 104 real, intent(in) :: a 105 integer :: i 106 complex :: z 107 108 ! Integer 109 call gee_i(i**0_1) 110 call gee_i(i**1_1) 111 call gee_i(i**2_1) 112 call gee_i(i**3_1) 113 call gee_i(i**(-1_1)) 114 call gee_i(i**(-2_1)) 115 call gee_i(i**(-3_1)) 116 call gee_i(i**huge(0_1)) 117 call gee_i(i**(-huge(0_1))) 118 call gee_i(i**(-huge(0_1)-1_1)) 119 120 call gee_i(i**0_2) 121 call gee_i(i**1_2) 122 call gee_i(i**2_2) 123 call gee_i(i**3_2) 124 call gee_i(i**(-1_2)) 125 call gee_i(i**(-2_2)) 126 call gee_i(i**(-3_2)) 127 call gee_i(i**huge(0_2)) 128 call gee_i(i**(-huge(0_2))) 129 call gee_i(i**(-huge(0_2)-1_2)) 130 131 call gee_i(i**0_4) 132 call gee_i(i**1_4) 133 call gee_i(i**2_4) 134 call gee_i(i**3_4) 135 call gee_i(i**(-1_4)) 136 call gee_i(i**(-2_4)) 137 call gee_i(i**(-3_4)) 138 call gee_i(i**huge(0_4)) 139 call gee_i(i**(-huge(0_4))) 140 call gee_i(i**(-huge(0_4)-1_4)) 141 142 call gee_i(i**0_8) ! { dg-warning "Type mismatch in argument" } 143 call gee_i(i**1_8) ! { dg-warning "Type mismatch in argument" } 144 call gee_i(i**2_8) ! { dg-warning "Type mismatch in argument" } 145 call gee_i(i**3_8) ! { dg-warning "Type mismatch in argument" } 146 call gee_i(i**(-1_8)) ! { dg-warning "Type mismatch in argument" } 147 call gee_i(i**(-2_8)) ! { dg-warning "Type mismatch in argument" } 148 call gee_i(i**(-3_8)) ! { dg-warning "Type mismatch in argument" } 149 call gee_i(i**huge(0_8)) ! { dg-warning "Type mismatch in argument" } 150 call gee_i(i**(-huge(0_8))) ! { dg-warning "Type mismatch in argument" } 151 call gee_i(i**(-huge(0_8)-1_8)) ! { dg-warning "Type mismatch in argument" } 152 153 ! Real 154 call gee_r(a**0_1) 155 call gee_r(a**1_1) 156 call gee_r(a**2_1) 157 call gee_r(a**3_1) 158 call gee_r(a**(-1_1)) 159 call gee_r(a**(-2_1)) 160 call gee_r(a**(-3_1)) 161 call gee_r(a**huge(0_1)) 162 call gee_r(a**(-huge(0_1))) 163 call gee_r(a**(-huge(0_1)-1_1)) 164 165 call gee_r(a**0_2) 166 call gee_r(a**1_2) 167 call gee_r(a**2_2) 168 call gee_r(a**3_2) 169 call gee_r(a**(-1_2)) 170 call gee_r(a**(-2_2)) 171 call gee_r(a**(-3_2)) 172 call gee_r(a**huge(0_2)) 173 call gee_r(a**(-huge(0_2))) 174 call gee_r(a**(-huge(0_2)-1_2)) 175 176 call gee_r(a**0_4) 177 call gee_r(a**1_4) 178 call gee_r(a**2_4) 179 call gee_r(a**3_4) 180 call gee_r(a**(-1_4)) 181 call gee_r(a**(-2_4)) 182 call gee_r(a**(-3_4)) 183 call gee_r(a**huge(0_4)) 184 call gee_r(a**(-huge(0_4))) 185 call gee_r(a**(-huge(0_4)-1_4)) 186 187 call gee_r(a**0_8) 188 call gee_r(a**1_8) 189 call gee_r(a**2_8) 190 call gee_r(a**3_8) 191 call gee_r(a**(-1_8)) 192 call gee_r(a**(-2_8)) 193 call gee_r(a**(-3_8)) 194 call gee_r(a**huge(0_8)) 195 call gee_r(a**(-huge(0_8))) 196 call gee_r(a**(-huge(0_8)-1_8)) 197 198 ! Complex 199 call gee_z(z**0_1) 200 call gee_z(z**1_1) 201 call gee_z(z**2_1) 202 call gee_z(z**3_1) 203 call gee_z(z**(-1_1)) 204 call gee_z(z**(-2_1)) 205 call gee_z(z**(-3_1)) 206 call gee_z(z**huge(0_1)) 207 call gee_z(z**(-huge(0_1))) 208 call gee_z(z**(-huge(0_1)-1_1)) 209 210 call gee_z(z**0_2) 211 call gee_z(z**1_2) 212 call gee_z(z**2_2) 213 call gee_z(z**3_2) 214 call gee_z(z**(-1_2)) 215 call gee_z(z**(-2_2)) 216 call gee_z(z**(-3_2)) 217 call gee_z(z**huge(0_2)) 218 call gee_z(z**(-huge(0_2))) 219 call gee_z(z**(-huge(0_2)-1_2)) 220 221 call gee_z(z**0_4) 222 call gee_z(z**1_4) 223 call gee_z(z**2_4) 224 call gee_z(z**3_4) 225 call gee_z(z**(-1_4)) 226 call gee_z(z**(-2_4)) 227 call gee_z(z**(-3_4)) 228 call gee_z(z**huge(0_4)) 229 call gee_z(z**(-huge(0_4))) 230 call gee_z(z**(-huge(0_4)-1_4)) 231 232 call gee_z(z**0_8) 233 call gee_z(z**1_8) 234 call gee_z(z**2_8) 235 call gee_z(z**3_8) 236 call gee_z(z**(-1_8)) 237 call gee_z(z**(-2_8)) 238 call gee_z(z**(-3_8)) 239 call gee_z(z**huge(0_8)) 240 call gee_z(z**(-huge(0_8))) 241 call gee_z(z**(-huge(0_8)-1_8)) 242end subroutine foo 243 244subroutine gee_i(i) 245 integer :: i 246end subroutine gee_i 247 248subroutine gee_r(r) 249 real :: r 250end subroutine gee_r 251 252subroutine gee_z(c) 253 complex :: c 254end subroutine gee_z 255