1 ! { dg-do run { xfail spu-*-* } }
2 ! FAILs on SPU because of wrong compile-time rounding mode
8 module procedure check_i8
9 module procedure check_i4
10 module procedure check_r8
11 module procedure check_r4
12 module procedure check_c8
13 module procedure check_c4
17 module procedure acheck_c8
18 module procedure acheck_c4
23 subroutine check_i8 (a, b)
24 integer(kind=8), intent(in) :: a, b
25 if (a /= b) call abort()
26 end subroutine check_i8
28 subroutine check_i4 (a, b)
29 integer(kind=4), intent(in) :: a, b
30 if (a /= b) call abort()
31 end subroutine check_i4
33 subroutine check_r8 (a, b)
34 real(kind=8), intent(in) :: a, b
35 if (a /= b) call abort()
36 end subroutine check_r8
38 subroutine check_r4 (a, b)
39 real(kind=4), intent(in) :: a, b
40 if (a /= b) call abort()
41 end subroutine check_r4
43 subroutine check_c8 (a, b)
44 complex(kind=8), intent(in) :: a, b
45 if (a /= b) call abort()
46 end subroutine check_c8
48 subroutine check_c4 (a, b)
49 complex(kind=4), intent(in) :: a, b
50 if (a /= b) call abort()
51 end subroutine check_c4
53 subroutine acheck_c8 (a, b)
54 complex(kind=8), intent(in) :: a, b
55 if (abs(a-b) > 1.d-9 * min(abs(a),abs(b))) call abort()
56 end subroutine acheck_c8
58 subroutine acheck_c4 (a, b)
59 complex(kind=4), intent(in) :: a, b
60 if (abs(a-b) > 1.e-5 * min(abs(a),abs(b))) call abort()
61 end subroutine acheck_c4
76 #define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
77 #define ATEST(base,exp,var) var = base; call acheck((var)**(exp),(base)**(exp))
79 !!!!! INTEGER BASE !!!!!
87 TEST(huge(0_8),0_8,i8)
88 TEST(-huge(0_4)-1,0,i4)
89 TEST(-huge(0_8)-1_8,0_8,i8)
100 TEST(1_8,huge(0_8),i8)
101 TEST(1,-huge(0)-1,i4)
102 TEST(1_8,-huge(0_8)-1_8,i8)
113 TEST(-1_8,huge(0_8),i8)
114 TEST(-1,-huge(0)-1,i4)
115 TEST(-1_8,-huge(0_8)-1_8,i8)
126 !!!!! REAL BASE !!!!!
132 TEST(0.0,huge(0_8),r4)
138 TEST(1.0,-huge(0)-1,r4)
142 TEST(1.0,huge(0_8),r4)
143 TEST(1.0,-huge(0_8)-1_8,r4)
148 TEST(-1.0,huge(0),r4)
149 TEST(-1.0,-huge(0)-1,r4)
153 TEST(-1.0,huge(0_8),r4)
154 TEST(-1.0,-huge(0_8)-1_8,r4)
167 TEST(nearest(1.0,-1.0),0,r4)
168 TEST(nearest(1.0,-1.0),huge(0_4),r4) ! { dg-warning "Arithmetic underflow" }
169 TEST(nearest(1.0,-1.0),0_8,r4)
170 TEST(nearest(1.0_8,-1.0),huge(0_8),r8) ! { dg-warning "Arithmetic underflow" }
172 TEST(nearest(1.0,-1.0),107,r4)
173 TEST(nearest(1.0,1.0),107,r4)
175 !!!!! COMPLEX BASE !!!!!
179 ATEST((1.0,0.2),9,c4)
180 ATEST((1.0,0.2),-1,c4)
181 ATEST((1.0,0.2),-2,c4)
182 ATEST((1.0,0.2),-9,c4)
187 ATEST((0.0,0.2),9,c4)
188 ATEST((0.0,0.2),-1,c4)
189 ATEST((0.0,0.2),-2,c4)
190 ATEST((0.0,0.2),-9,c4)
196 ATEST((1.0,0.),-1,c4)
197 ATEST((1.0,0.),-2,c4)
198 ATEST((1.0,0.),-9,c4)
202 ! { dg-final { cleanup-modules "mod_check" } }