OSDN Git Service

e5c4052bacbf84df5f68d171b7e8bd3b2e468eb9
[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 "" }
4 module mod_check
5   implicit none
6
7   interface check
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
14   end interface check
15
16   interface acheck
17     module procedure acheck_c8
18     module procedure acheck_c4
19   end interface acheck
20
21 contains
22
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
27
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
32
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
37
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
42
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
47
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
52
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
57
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
62
63 end module mod_check
64
65 program test
66   use mod_check
67   implicit none
68
69   integer(kind=4) :: i4
70   integer(kind=8) :: i8
71   real(kind=4) :: r4
72   real(kind=8) :: r8
73   complex(kind=4) :: c4
74   complex(kind=8) :: c8
75
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))
78
79 !!!!! INTEGER BASE !!!!!
80   TEST(0,0,i4)
81   TEST(0_8,0_8,i8)
82   TEST(1,0,i4)
83   TEST(1_8,0_8,i8)
84   TEST(-1,0,i4)
85   TEST(-1_8,0_8,i8)
86   TEST(huge(0_4),0,i4)
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)
90
91   TEST(1,1,i4)
92   TEST(1_8,1_8,i8)
93   TEST(1,2,i4)
94   TEST(1_8,2_8,i8)
95   TEST(1,-1,i4)
96   TEST(1_8,-1_8,i8)
97   TEST(1,-2,i4)
98   TEST(1_8,-2_8,i8)
99   TEST(1,huge(0),i4)
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)
103
104   TEST(-1,1,i4)
105   TEST(-1_8,1_8,i8)
106   TEST(-1,2,i4)
107   TEST(-1_8,2_8,i8)
108   TEST(-1,-1,i4)
109   TEST(-1_8,-1_8,i8)
110   TEST(-1,-2,i4)
111   TEST(-1_8,-2_8,i8)
112   TEST(-1,huge(0),i4)
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)
116
117   TEST(2,9,i4)
118   TEST(2_8,9_8,i8)
119   TEST(-2,9,i4)
120   TEST(-2_8,9_8,i8)
121   TEST(2,-9,i4)
122   TEST(2_8,-9_8,i8)
123   TEST(-2,-9,i4)
124   TEST(-2_8,-9_8,i8)
125
126 !!!!! REAL BASE !!!!!
127   TEST(0.0,0,r4)
128   TEST(0.0,1,r4)
129   TEST(0.0,huge(0),r4)
130   TEST(0.0,0_8,r4)
131   TEST(0.0,1_8,r4)
132   TEST(0.0,huge(0_8),r4)
133
134   TEST(1.0,0,r4)
135   TEST(1.0,1,r4)
136   TEST(1.0,-1,r4)
137   TEST(1.0,huge(0),r4)
138   TEST(1.0,-huge(0)-1,r4)
139   TEST(1.0,0_8,r4)
140   TEST(1.0,1_8,r4)
141   TEST(1.0,-1_8,r4)
142   TEST(1.0,huge(0_8),r4)
143   TEST(1.0,-huge(0_8)-1_8,r4)
144
145   TEST(-1.0,0,r4)
146   TEST(-1.0,1,r4)
147   TEST(-1.0,-1,r4)
148   TEST(-1.0,huge(0),r4)
149   TEST(-1.0,-huge(0)-1,r4)
150   TEST(-1.0,0_8,r4)
151   TEST(-1.0,1_8,r4)
152   TEST(-1.0,-1_8,r4)
153   TEST(-1.0,huge(0_8),r4)
154   TEST(-1.0,-huge(0_8)-1_8,r4)
155
156   TEST(2.0,0,r4)
157   TEST(2.0,1,r4)
158   TEST(2.0,-1,r4)
159   TEST(2.0,3,r4)
160   TEST(2.0,-3,r4)
161   TEST(2.0,0_8,r4)
162   TEST(2.0,1_8,r4)
163   TEST(2.0,-1_8,r4)
164   TEST(2.0,3_8,r4)
165   TEST(2.0,-3_8,r4)
166
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" }
171
172   TEST(nearest(1.0,-1.0),107,r4)
173   TEST(nearest(1.0,1.0),107,r4)
174
175 !!!!! COMPLEX BASE !!!!!
176   TEST((1.0,0.2),0,c4)
177   TEST((1.0,0.2),1,c4)
178   TEST((1.0,0.2),2,c4)
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)
183
184   TEST((0.0,0.2),0,c4)
185   TEST((0.0,0.2),1,c4)
186   TEST((0.0,0.2),2,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)
191
192   TEST((1.0,0.),0,c4)
193   TEST((1.0,0.),1,c4)
194   TEST((1.0,0.),2,c4)
195   TEST((1.0,0.),9,c4)
196   ATEST((1.0,0.),-1,c4)
197   ATEST((1.0,0.),-2,c4)
198   ATEST((1.0,0.),-9,c4)
199
200 end program test
201
202 ! { dg-final { cleanup-modules "mod_check" } }