7 module procedure check_i8
8 module procedure check_i4
9 module procedure check_r8
10 module procedure check_r4
11 module procedure check_c8
12 module procedure check_c4
16 module procedure acheck_c8
17 module procedure acheck_c4
22 subroutine check_i8 (a, b)
23 integer(kind=8), intent(in) :: a, b
24 if (a /= b) call abort()
25 end subroutine check_i8
27 subroutine check_i4 (a, b)
28 integer(kind=4), intent(in) :: a, b
29 if (a /= b) call abort()
30 end subroutine check_i4
32 subroutine check_r8 (a, b)
33 real(kind=8), intent(in) :: a, b
34 if (a /= b) call abort()
35 end subroutine check_r8
37 subroutine check_r4 (a, b)
38 real(kind=4), intent(in) :: a, b
39 if (a /= b) call abort()
40 end subroutine check_r4
42 subroutine check_c8 (a, b)
43 complex(kind=8), intent(in) :: a, b
44 if (a /= b) call abort()
45 end subroutine check_c8
47 subroutine check_c4 (a, b)
48 complex(kind=4), intent(in) :: a, b
49 if (a /= b) call abort()
50 end subroutine check_c4
52 subroutine acheck_c8 (a, b)
53 complex(kind=8), intent(in) :: a, b
54 if (abs(a-b) > 1.d-9 * min(abs(a),abs(b))) call abort()
55 end subroutine acheck_c8
57 subroutine acheck_c4 (a, b)
58 complex(kind=4), intent(in) :: a, b
59 if (abs(a-b) > 1.e-5 * min(abs(a),abs(b))) call abort()
60 end subroutine acheck_c4
75 #define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
76 #define ATEST(base,exp,var) var = base; call acheck((var)**(exp),(base)**(exp))
78 !!!!! INTEGER BASE !!!!!
86 TEST(huge(0_8),0_8,i8)
87 TEST(-huge(0_4)-1,0,i4)
88 TEST(-huge(0_8)-1_8,0_8,i8)
99 TEST(1_8,huge(0_8),i8)
100 TEST(1,-huge(0)-1,i4)
101 TEST(1_8,-huge(0_8)-1_8,i8)
112 TEST(-1_8,huge(0_8),i8)
113 TEST(-1,-huge(0)-1,i4)
114 TEST(-1_8,-huge(0_8)-1_8,i8)
125 !!!!! REAL BASE !!!!!
131 TEST(0.0,huge(0_8),r4)
137 TEST(1.0,-huge(0)-1,r4)
141 TEST(1.0,huge(0_8),r4)
142 TEST(1.0,-huge(0_8)-1_8,r4)
147 TEST(-1.0,huge(0),r4)
148 TEST(-1.0,-huge(0)-1,r4)
152 TEST(-1.0,huge(0_8),r4)
153 TEST(-1.0,-huge(0_8)-1_8,r4)
166 TEST(nearest(1.0,-1.0),0,r4)
167 TEST(nearest(1.0,-1.0),huge(0_4),r4) ! { dg-warning "Arithmetic underflow" }
168 TEST(nearest(1.0,-1.0),0_8,r4)
169 TEST(nearest(1.0_8,-1.0),huge(0_8),r8) ! { dg-warning "Arithmetic underflow" }
171 TEST(nearest(1.0,-1.0),107,r4)
172 TEST(nearest(1.0,1.0),107,r4)
174 !!!!! COMPLEX BASE !!!!!
178 ATEST((1.0,0.2),9,c4)
179 ATEST((1.0,0.2),-1,c4)
180 ATEST((1.0,0.2),-2,c4)
181 ATEST((1.0,0.2),-9,c4)
186 ATEST((0.0,0.2),9,c4)
187 ATEST((0.0,0.2),-1,c4)
188 ATEST((0.0,0.2),-2,c4)
189 ATEST((0.0,0.2),-9,c4)
195 ATEST((1.0,0.),-1,c4)
196 ATEST((1.0,0.),-2,c4)
197 ATEST((1.0,0.),-9,c4)
201 ! { dg-final { cleanup-modules "mod_check" } }