2 ! { dg-options "-ffloat-store" { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
9 module procedure check_i8
10 module procedure check_i4
11 module procedure check_r8
12 module procedure check_r4
13 module procedure check_c8
14 module procedure check_c4
18 module procedure acheck_c8
19 module procedure acheck_c4
24 subroutine check_i8 (a, b)
25 integer(kind=8), intent(in) :: a, b
27 end subroutine check_i8
29 subroutine check_i4 (a, b)
30 integer(kind=4), intent(in) :: a, b
32 end subroutine check_i4
34 subroutine check_r8 (a, b)
35 real(kind=8), intent(in) :: a, b
37 end subroutine check_r8
39 subroutine check_r4 (a, b)
40 real(kind=4), intent(in) :: a, b
42 end subroutine check_r4
44 subroutine check_c8 (a, b)
45 complex(kind=8), intent(in) :: a, b
47 end subroutine check_c8
49 subroutine check_c4 (a, b)
50 complex(kind=4), intent(in) :: a, b
52 end subroutine check_c4
54 subroutine acheck_c8 (a, b)
55 complex(kind=8), intent(in) :: a, b
56 if (abs(a-b) > 1.d-9 * min(abs(a),abs(b))) STOP 7
57 end subroutine acheck_c8
59 subroutine acheck_c4 (a, b)
60 complex(kind=4), intent(in) :: a, b
61 if (abs(a-b) > 1.e-5 * min(abs(a),abs(b))) STOP 8
62 end subroutine acheck_c4
77 #define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
78 #define ATEST(base,exp,var) var = base; call acheck((var)**(exp),(base)**(exp))
80 !!!!! INTEGER BASE !!!!!
88 TEST(huge(0_8),0_8,i8)
89 TEST(-huge(0_4)-1,0,i4)
90 TEST(-huge(0_8)-1_8,0_8,i8)
101 TEST(1_8,huge(0_8),i8)
102 TEST(1,-huge(0)-1,i4)
103 TEST(1_8,-huge(0_8)-1_8,i8)
114 TEST(-1_8,huge(0_8),i8)
115 TEST(-1,-huge(0)-1,i4)
116 TEST(-1_8,-huge(0_8)-1_8,i8)
127 !!!!! REAL BASE !!!!!
133 TEST(0.0,huge(0_8),r4)
139 TEST(1.0,-huge(0)-1,r4)
143 TEST(1.0,huge(0_8),r4)
144 TEST(1.0,-huge(0_8)-1_8,r4)
149 TEST(-1.0,huge(0),r4)
150 TEST(-1.0,-huge(0)-1,r4)
154 TEST(-1.0,huge(0_8),r4)
155 TEST(-1.0,-huge(0_8)-1_8,r4)
168 TEST(nearest(1.0,-1.0),0,r4)
169 TEST(nearest(1.0,-1.0),huge(0_4),r4) ! { dg-warning "Arithmetic underflow" }
170 TEST(nearest(1.0,-1.0),0_8,r4)
171 TEST(nearest(1.0_8,-1.0),huge(0_8),r8) ! { dg-warning "Arithmetic underflow" }
173 TEST(nearest(1.0,-1.0),107,r4)
174 TEST(nearest(1.0,1.0),107,r4)
176 !!!!! COMPLEX BASE !!!!!
180 ATEST((1.0,0.2),9,c4)
181 ATEST((1.0,0.2),-1,c4)
182 ATEST((1.0,0.2),-2,c4)
183 ATEST((1.0,0.2),-9,c4)
188 ATEST((0.0,0.2),9,c4)
189 ATEST((0.0,0.2),-1,c4)
190 ATEST((0.0,0.2),-2,c4)
191 ATEST((0.0,0.2),-9,c4)
197 ATEST((1.0,0.),-1,c4)
198 ATEST((1.0,0.),-2,c4)
199 ATEST((1.0,0.),-9,c4)