gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90

   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 }
   5 module 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
  17 contains
  18
  19   subroutine check_i8 (a, b)
  20     integer(kind=8), intent(in) :: a, b
  21     if (a /= b) STOP 1
  22   end subroutine check_i8
  23
  24   subroutine check_i4 (a, b)
  25     integer(kind=4), intent(in) :: a, b
  26     if (a /= b) STOP 2
  27   end subroutine check_i4
  28
  29   subroutine check_r8 (a, b)
  30     real(kind=8), intent(in) :: a, b
  31     if (a /= b) STOP 3
  32   end subroutine check_r8
  33
  34   subroutine check_r4 (a, b)
  35     real(kind=4), intent(in) :: a, b
  36     if (a /= b) STOP 4
  37   end subroutine check_r4
  38
  39   subroutine check_c8 (a, b)
  40     complex(kind=8), intent(in) :: a, b
  41     if (a /= b) STOP 5
  42   end subroutine check_c8
  43
  44   subroutine check_c4 (a, b)
  45     complex(kind=4), intent(in) :: a, b
  46     if (a /= b) STOP 6
  47   end subroutine check_c4
  48
  49 end module mod_check
  50
  51 program 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
  78 end program test