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