OSDN Git Service

9277b7a7ccda86c7a0281a80d2db89a8dee4c462
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / integer_exponentiation_3.F90
1 ! { dg-do run { xfail spu-*-* } }
2 ! FAILs on SPU because of wrong compile-time rounding mode
3 ! { dg-options "-ffloat-store" }
4 !
5 ! -ffloat-store needed for x87
6 !
7 module mod_check
8   implicit none
9
10   interface check
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
17   end interface check
18
19   interface acheck
20     module procedure acheck_c8
21     module procedure acheck_c4
22   end interface acheck
23
24 contains
25
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
30
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
35
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
40
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
45
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
50
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
55
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
60
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
65
66 end module mod_check
67
68 program test
69   use mod_check
70   implicit none
71
72   integer(kind=4) :: i4
73   integer(kind=8) :: i8
74   real(kind=4) :: r4
75   real(kind=8) :: r8
76   complex(kind=4) :: c4
77   complex(kind=8) :: c8
78
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))
81
82 !!!!! INTEGER BASE !!!!!
83   TEST(0,0,i4)
84   TEST(0_8,0_8,i8)
85   TEST(1,0,i4)
86   TEST(1_8,0_8,i8)
87   TEST(-1,0,i4)
88   TEST(-1_8,0_8,i8)
89   TEST(huge(0_4),0,i4)
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)
93
94   TEST(1,1,i4)
95   TEST(1_8,1_8,i8)
96   TEST(1,2,i4)
97   TEST(1_8,2_8,i8)
98   TEST(1,-1,i4)
99   TEST(1_8,-1_8,i8)
100   TEST(1,-2,i4)
101   TEST(1_8,-2_8,i8)
102   TEST(1,huge(0),i4)
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)
106
107   TEST(-1,1,i4)
108   TEST(-1_8,1_8,i8)
109   TEST(-1,2,i4)
110   TEST(-1_8,2_8,i8)
111   TEST(-1,-1,i4)
112   TEST(-1_8,-1_8,i8)
113   TEST(-1,-2,i4)
114   TEST(-1_8,-2_8,i8)
115   TEST(-1,huge(0),i4)
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)
119
120   TEST(2,9,i4)
121   TEST(2_8,9_8,i8)
122   TEST(-2,9,i4)
123   TEST(-2_8,9_8,i8)
124   TEST(2,-9,i4)
125   TEST(2_8,-9_8,i8)
126   TEST(-2,-9,i4)
127   TEST(-2_8,-9_8,i8)
128
129 !!!!! REAL BASE !!!!!
130   TEST(0.0,0,r4)
131   TEST(0.0,1,r4)
132   TEST(0.0,huge(0),r4)
133   TEST(0.0,0_8,r4)
134   TEST(0.0,1_8,r4)
135   TEST(0.0,huge(0_8),r4)
136
137   TEST(1.0,0,r4)
138   TEST(1.0,1,r4)
139   TEST(1.0,-1,r4)
140   TEST(1.0,huge(0),r4)
141   TEST(1.0,-huge(0)-1,r4)
142   TEST(1.0,0_8,r4)
143   TEST(1.0,1_8,r4)
144   TEST(1.0,-1_8,r4)
145   TEST(1.0,huge(0_8),r4)
146   TEST(1.0,-huge(0_8)-1_8,r4)
147
148   TEST(-1.0,0,r4)
149   TEST(-1.0,1,r4)
150   TEST(-1.0,-1,r4)
151   TEST(-1.0,huge(0),r4)
152   TEST(-1.0,-huge(0)-1,r4)
153   TEST(-1.0,0_8,r4)
154   TEST(-1.0,1_8,r4)
155   TEST(-1.0,-1_8,r4)
156   TEST(-1.0,huge(0_8),r4)
157   TEST(-1.0,-huge(0_8)-1_8,r4)
158
159   TEST(2.0,0,r4)
160   TEST(2.0,1,r4)
161   TEST(2.0,-1,r4)
162   TEST(2.0,3,r4)
163   TEST(2.0,-3,r4)
164   TEST(2.0,0_8,r4)
165   TEST(2.0,1_8,r4)
166   TEST(2.0,-1_8,r4)
167   TEST(2.0,3_8,r4)
168   TEST(2.0,-3_8,r4)
169
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" }
174
175   TEST(nearest(1.0,-1.0),107,r4)
176   TEST(nearest(1.0,1.0),107,r4)
177
178 !!!!! COMPLEX BASE !!!!!
179   TEST((1.0,0.2),0,c4)
180   TEST((1.0,0.2),1,c4)
181   TEST((1.0,0.2),2,c4)
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)
186
187   TEST((0.0,0.2),0,c4)
188   TEST((0.0,0.2),1,c4)
189   TEST((0.0,0.2),2,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)
194
195   TEST((1.0,0.),0,c4)
196   TEST((1.0,0.),1,c4)
197   TEST((1.0,0.),2,c4)
198   TEST((1.0,0.),9,c4)
199   ATEST((1.0,0.),-1,c4)
200   ATEST((1.0,0.),-2,c4)
201   ATEST((1.0,0.),-9,c4)
202
203 end program test
204
205 ! { dg-final { cleanup-modules "mod_check" } }