OSDN Git Service

55d00ba28b87d65dec2ad0cef10ecf1560eee091
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / integer_exponentiation_2.f90
1 ! { dg-do run }
2 ! { dg-options "" }
3 ! Test various exponentations
4 ! initially designed for patch to PR31120
5
6 program test
7   call run_me (1.0, 1, (1.0,0.0))
8   call run_me (-1.1, -1, (0.0,-1.0))
9   call run_me (42.0, 12, (1.0,7.0))
10 end program test
11
12 ! This subroutine is for runtime tests
13 subroutine run_me(a, i, z)
14   implicit none
15
16   real, intent(in) :: a
17   integer, intent(in) :: i
18   complex, intent(in) :: z
19
20   call check_equal_i (i**0, 1)
21   call check_equal_i (i**1, i)
22   call check_equal_i (i**2, i*i)
23   call check_equal_i (i**3, i*(i**2))
24
25   ! i has default integer kind.
26   call check_equal_i (int(i**0_8,kind=kind(i)), 1)
27   call check_equal_i (int(i**1_8,kind=kind(i)), i)
28   call check_equal_i (int(i**2_8,kind=kind(i)), i*i)
29   call check_equal_i (int(i**3_8,kind=kind(i)), i*i*i)
30
31   call check_equal_r (a**0.0, 1.0)
32   call check_equal_r (a**1.0, a)
33   call check_equal_r (a**2.0, a*a)
34   call check_equal_r (a**3.0, a*(a**2))
35   call check_equal_r (a**-1.0, 1/a)
36   call check_equal_r (a**-2.0, (1/a)*(1/a))
37
38   call check_equal_r (a**0, 1.0)
39   call check_equal_r (a**1, a)
40   call check_equal_r (a**2, a*a)
41   call check_equal_r (a**3, a*(a**2))
42   call check_equal_r (a**-1, 1/a)
43   call check_equal_r (a**-2, (1/a)*(1/a))
44
45   call check_equal_r (a**0_8, 1.0)
46   call check_equal_r (a**1_8, a)
47   call check_equal_r (a**2_8, a*a)
48   call check_equal_r (a**3_8, a*(a**2))
49   call check_equal_r (a**-1_8, 1/a)
50   call check_equal_r (a**-2_8, (1/a)*(1/a))
51
52   call check_equal_c (z**0.0, (1.0,0.0))
53   call check_equal_c (z**1.0, z)
54   call check_equal_c (z**2.0, z*z)
55   call check_equal_c (z**3.0, z*(z**2))
56   call check_equal_c (z**-1.0, 1/z)
57   call check_equal_c (z**-2.0, (1/z)*(1/z))
58
59   call check_equal_c (z**(0.0,0.0), (1.0,0.0))
60   call check_equal_c (z**(1.0,0.0), z)
61   call check_equal_c (z**(2.0,0.0), z*z)
62   call check_equal_c (z**(3.0,0.0), z*(z**2))
63   call check_equal_c (z**(-1.0,0.0), 1/z)
64   call check_equal_c (z**(-2.0,0.0), (1/z)*(1/z))
65
66   call check_equal_c (z**0, (1.0,0.0))
67   call check_equal_c (z**1, z)
68   call check_equal_c (z**2, z*z)
69   call check_equal_c (z**3, z*(z**2))
70   call check_equal_c (z**-1, 1/z)
71   call check_equal_c (z**-2, (1/z)*(1/z))
72
73   call check_equal_c (z**0_8, (1.0,0.0))
74   call check_equal_c (z**1_8, z)
75   call check_equal_c (z**2_8, z*z)
76   call check_equal_c (z**3_8, z*(z**2))
77   call check_equal_c (z**-1_8, 1/z)
78   call check_equal_c (z**-2_8, (1/z)*(1/z))
79
80
81 contains
82
83   subroutine check_equal_r (a, b)
84     real, intent(in) :: a, b
85     if (abs(a - b) > 1.e-5 * abs(b)) call abort
86   end subroutine check_equal_r
87
88   subroutine check_equal_c (a, b)
89     complex, intent(in) :: a, b
90     if (abs(a - b) > 1.e-5 * abs(b)) call abort
91   end subroutine check_equal_c
92
93   subroutine check_equal_i (a, b)
94     integer, intent(in) :: a, b
95     if (a /= b) call abort
96   end subroutine check_equal_i
97
98 end subroutine run_me
99
100 ! subroutine foo is used for compilation test only
101 subroutine foo(a)
102   implicit none
103
104   real, intent(in) :: a
105   integer :: i
106   complex :: z
107
108   ! Integer
109   call gee_i(i**0_1)
110   call gee_i(i**1_1)
111   call gee_i(i**2_1)
112   call gee_i(i**3_1)
113   call gee_i(i**-1_1)
114   call gee_i(i**-2_1)
115   call gee_i(i**-3_1)
116   call gee_i(i**huge(0_1))
117   call gee_i(i**-huge(0_1))
118   call gee_i(i**(-huge(0_1)-1_1))
119
120   call gee_i(i**0_2)
121   call gee_i(i**1_2)
122   call gee_i(i**2_2)
123   call gee_i(i**3_2)
124   call gee_i(i**-1_2)
125   call gee_i(i**-2_2)
126   call gee_i(i**-3_2)
127   call gee_i(i**huge(0_2))
128   call gee_i(i**-huge(0_2))
129   call gee_i(i**(-huge(0_2)-1_2))
130
131   call gee_i(i**0_4)
132   call gee_i(i**1_4)
133   call gee_i(i**2_4)
134   call gee_i(i**3_4)
135   call gee_i(i**-1_4)
136   call gee_i(i**-2_4)
137   call gee_i(i**-3_4)
138   call gee_i(i**huge(0_4))
139   call gee_i(i**-huge(0_4))
140   call gee_i(i**(-huge(0_4)-1_4))
141
142   call gee_i(i**0_8)
143   call gee_i(i**1_8)
144   call gee_i(i**2_8)
145   call gee_i(i**3_8)
146   call gee_i(i**-1_8)
147   call gee_i(i**-2_8)
148   call gee_i(i**-3_8)
149   call gee_i(i**huge(0_8))
150   call gee_i(i**-huge(0_8))
151   call gee_i(i**(-huge(0_8)-1_8))
152
153   ! Real
154   call gee_r(a**0_1)
155   call gee_r(a**1_1)
156   call gee_r(a**2_1)
157   call gee_r(a**3_1)
158   call gee_r(a**-1_1)
159   call gee_r(a**-2_1)
160   call gee_r(a**-3_1)
161   call gee_r(a**huge(0_1))
162   call gee_r(a**-huge(0_1))
163   call gee_r(a**(-huge(0_1)-1_1))
164
165   call gee_r(a**0_2)
166   call gee_r(a**1_2)
167   call gee_r(a**2_2)
168   call gee_r(a**3_2)
169   call gee_r(a**-1_2)
170   call gee_r(a**-2_2)
171   call gee_r(a**-3_2)
172   call gee_r(a**huge(0_2))
173   call gee_r(a**-huge(0_2))
174   call gee_r(a**(-huge(0_2)-1_2))
175
176   call gee_r(a**0_4)
177   call gee_r(a**1_4)
178   call gee_r(a**2_4)
179   call gee_r(a**3_4)
180   call gee_r(a**-1_4)
181   call gee_r(a**-2_4)
182   call gee_r(a**-3_4)
183   call gee_r(a**huge(0_4))
184   call gee_r(a**-huge(0_4))
185   call gee_r(a**(-huge(0_4)-1_4))
186
187   call gee_r(a**0_8)
188   call gee_r(a**1_8)
189   call gee_r(a**2_8)
190   call gee_r(a**3_8)
191   call gee_r(a**-1_8)
192   call gee_r(a**-2_8)
193   call gee_r(a**-3_8)
194   call gee_r(a**huge(0_8))
195   call gee_r(a**-huge(0_8))
196   call gee_r(a**(-huge(0_8)-1_8))
197
198   ! Complex
199   call gee_z(z**0_1)
200   call gee_z(z**1_1)
201   call gee_z(z**2_1)
202   call gee_z(z**3_1)
203   call gee_z(z**-1_1)
204   call gee_z(z**-2_1)
205   call gee_z(z**-3_1)
206   call gee_z(z**huge(0_1))
207   call gee_z(z**-huge(0_1))
208   call gee_z(z**(-huge(0_1)-1_1))
209
210   call gee_z(z**0_2)
211   call gee_z(z**1_2)
212   call gee_z(z**2_2)
213   call gee_z(z**3_2)
214   call gee_z(z**-1_2)
215   call gee_z(z**-2_2)
216   call gee_z(z**-3_2)
217   call gee_z(z**huge(0_2))
218   call gee_z(z**-huge(0_2))
219   call gee_z(z**(-huge(0_2)-1_2))
220
221   call gee_z(z**0_4)
222   call gee_z(z**1_4)
223   call gee_z(z**2_4)
224   call gee_z(z**3_4)
225   call gee_z(z**-1_4)
226   call gee_z(z**-2_4)
227   call gee_z(z**-3_4)
228   call gee_z(z**huge(0_4))
229   call gee_z(z**-huge(0_4))
230   call gee_z(z**(-huge(0_4)-1_4))
231
232   call gee_z(z**0_8)
233   call gee_z(z**1_8)
234   call gee_z(z**2_8)
235   call gee_z(z**3_8)
236   call gee_z(z**-1_8)
237   call gee_z(z**-2_8)
238   call gee_z(z**-3_8)
239   call gee_z(z**huge(0_8))
240   call gee_z(z**-huge(0_8))
241   call gee_z(z**(-huge(0_8)-1_8))
242 end subroutine foo
243
244 subroutine gee_i(i)
245   integer :: i
246 end subroutine gee_i
247
248 subroutine gee_r(r)
249   real :: r
250 end subroutine gee_r
251
252 subroutine gee_z(c)
253   complex :: c
254 end subroutine gee_z