1! { dg-do run { xfail spu-*-* } }
2! FAILs on SPU because of invalid result of 1.0/0.0 inline code
3! { dg-options "-fno-range-check" }
4! { dg-add-options ieee }
5module mod_check
6  implicit none
7
8  interface check
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
15  end interface check
16
17contains
18
19  subroutine check_i8 (a, b)
20    integer(kind=8), intent(in) :: a, b
21    if (a /= b) call abort()
22  end subroutine check_i8
23
24  subroutine check_i4 (a, b)
25    integer(kind=4), intent(in) :: a, b
26    if (a /= b) call abort()
27  end subroutine check_i4
28
29  subroutine check_r8 (a, b)
30    real(kind=8), intent(in) :: a, b
31    if (a /= b) call abort()
32  end subroutine check_r8
33
34  subroutine check_r4 (a, b)
35    real(kind=4), intent(in) :: a, b
36    if (a /= b) call abort()
37  end subroutine check_r4
38
39  subroutine check_c8 (a, b)
40    complex(kind=8), intent(in) :: a, b
41    if (a /= b) call abort()
42  end subroutine check_c8
43
44  subroutine check_c4 (a, b)
45    complex(kind=4), intent(in) :: a, b
46    if (a /= b) call abort()
47  end subroutine check_c4
48
49end module mod_check
50
51program test
52  use mod_check
53  implicit none
54
55  integer(kind=4) :: i4
56  integer(kind=8) :: i8
57  real(kind=4) :: r4
58  real(kind=8) :: r8
59  complex(kind=4) :: c4
60  complex(kind=8) :: c8
61
62#define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
63
64!!!!! INTEGER BASE !!!!!
65  TEST(3,23,i4)
66  TEST(-3,23,i4)
67  TEST(3_8,43_8,i8)
68  TEST(-3_8,43_8,i8)
69
70  TEST(17_8,int(huge(0_4),kind=8)+1,i8)
71
72!!!!! REAL BASE !!!!!
73  TEST(0.0,-1,r4)
74  TEST(0.0,-huge(0)-1,r4)
75  TEST(2.0,huge(0),r4)
76  TEST(nearest(1.0,-1.0),-huge(0),r4)
77
78end program test
79