1 ! { dg-do run { xfail spu-*-* } }
2 ! FAILs on SPU because of wrong compile-time rounding mode
4 ! { dg-options "-ffloat-store" { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
11 module procedure check_i8
12 module procedure check_i4
13 module procedure check_r8
14 module procedure check_r4
15 module procedure check_c8
16 module procedure check_c4
20 module procedure acheck_c8
21 module procedure acheck_c4
26 subroutine check_i8 (a, b)
27 integer(kind=8), intent(in) :: a, b
28 if (a /= b) call abort()
29 end subroutine check_i8
31 subroutine check_i4 (a, b)
32 integer(kind=4), intent(in) :: a, b
33 if (a /= b) call abort()
34 end subroutine check_i4
36 subroutine check_r8 (a, b)
37 real(kind=8), intent(in) :: a, b
38 if (a /= b) call abort()
39 end subroutine check_r8
41 subroutine check_r4 (a, b)
42 real(kind=4), intent(in) :: a, b
43 if (a /= b) call abort()
44 end subroutine check_r4
46 subroutine check_c8 (a, b)
47 complex(kind=8), intent(in) :: a, b
48 if (a /= b) call abort()
49 end subroutine check_c8
51 subroutine check_c4 (a, b)
52 complex(kind=4), intent(in) :: a, b
53 if (a /= b) call abort()
54 end subroutine check_c4
56 subroutine acheck_c8 (a, b)
57 complex(kind=8), intent(in) :: a, b
58 if (abs(a-b) > 1.d-9 * min(abs(a),abs(b))) call abort()
59 end subroutine acheck_c8
61 subroutine acheck_c4 (a, b)
62 complex(kind=4), intent(in) :: a, b
63 if (abs(a-b) > 1.e-5 * min(abs(a),abs(b))) call abort()
64 end subroutine acheck_c4
79 #define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
80 #define ATEST(base,exp,var) var = base; call acheck((var)**(exp),(base)**(exp))
82 !!!!! INTEGER BASE !!!!!
90 TEST(huge(0_8),0_8,i8)
91 TEST(-huge(0_4)-1,0,i4)
92 TEST(-huge(0_8)-1_8,0_8,i8)
103 TEST(1_8,huge(0_8),i8)
104 TEST(1,-huge(0)-1,i4)
105 TEST(1_8,-huge(0_8)-1_8,i8)
116 TEST(-1_8,huge(0_8),i8)
117 TEST(-1,-huge(0)-1,i4)
118 TEST(-1_8,-huge(0_8)-1_8,i8)
129 !!!!! REAL BASE !!!!!
135 TEST(0.0,huge(0_8),r4)
141 TEST(1.0,-huge(0)-1,r4)
145 TEST(1.0,huge(0_8),r4)
146 TEST(1.0,-huge(0_8)-1_8,r4)
151 TEST(-1.0,huge(0),r4)
152 TEST(-1.0,-huge(0)-1,r4)
156 TEST(-1.0,huge(0_8),r4)
157 TEST(-1.0,-huge(0_8)-1_8,r4)
170 TEST(nearest(1.0,-1.0),0,r4)
171 TEST(nearest(1.0,-1.0),huge(0_4),r4) ! { dg-warning "Arithmetic underflow" }
172 TEST(nearest(1.0,-1.0),0_8,r4)
173 TEST(nearest(1.0_8,-1.0),huge(0_8),r8) ! { dg-warning "Arithmetic underflow" }
175 TEST(nearest(1.0,-1.0),107,r4)
176 TEST(nearest(1.0,1.0),107,r4)
178 !!!!! COMPLEX BASE !!!!!
182 ATEST((1.0,0.2),9,c4)
183 ATEST((1.0,0.2),-1,c4)
184 ATEST((1.0,0.2),-2,c4)
185 ATEST((1.0,0.2),-9,c4)
190 ATEST((0.0,0.2),9,c4)
191 ATEST((0.0,0.2),-1,c4)
192 ATEST((0.0,0.2),-2,c4)
193 ATEST((0.0,0.2),-9,c4)
199 ATEST((1.0,0.),-1,c4)
200 ATEST((1.0,0.),-2,c4)
201 ATEST((1.0,0.),-9,c4)