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 ! { dg-options "-ffloat-store" { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
   5 !
   6 !
   7 module mod_check
   8   implicit none
   9
  10   interface check
  11     module procedure check_i8
  12     module procedure check_i4
  13     module procedure check_r8
  14     module procedure check_r4
  15     module procedure check_c8
  16     module procedure check_c4
  17   end interface check
  18
  19   interface acheck
  20     module procedure acheck_c8
  21     module procedure acheck_c4
  22   end interface acheck
  23
  24 contains
  25
  26   subroutine check_i8 (a, b)
  27     integer(kind=8), intent(in) :: a, b
  28     if (a /= b) call abort()
  29   end subroutine check_i8
  30
  31   subroutine check_i4 (a, b)
  32     integer(kind=4), intent(in) :: a, b
  33     if (a /= b) call abort()
  34   end subroutine check_i4
  35
  36   subroutine check_r8 (a, b)
  37     real(kind=8), intent(in) :: a, b
  38     if (a /= b) call abort()
  39   end subroutine check_r8
  40
  41   subroutine check_r4 (a, b)
  42     real(kind=4), intent(in) :: a, b
  43     if (a /= b) call abort()
  44   end subroutine check_r4
  45
  46   subroutine check_c8 (a, b)
  47     complex(kind=8), intent(in) :: a, b
  48     if (a /= b) call abort()
  49   end subroutine check_c8
  50
  51   subroutine check_c4 (a, b)
  52     complex(kind=4), intent(in) :: a, b
  53     if (a /= b) call abort()
  54   end subroutine check_c4
  55
  56   subroutine acheck_c8 (a, b)
  57     complex(kind=8), intent(in) :: a, b
  58     if (abs(a-b) > 1.d-9 * min(abs(a),abs(b))) call abort()
  59   end subroutine acheck_c8
  60
  61   subroutine acheck_c4 (a, b)
  62     complex(kind=4), intent(in) :: a, b
  63     if (abs(a-b) > 1.e-5 * min(abs(a),abs(b))) call abort()
  64   end subroutine acheck_c4
  65
  66 end module mod_check
  67
  68 program test
  69   use mod_check
  70   implicit none
  71
  72   integer(kind=4) :: i4
  73   integer(kind=8) :: i8
  74   real(kind=4) :: r4
  75   real(kind=8) :: r8
  76   complex(kind=4) :: c4
  77   complex(kind=8) :: c8
  78
  79 #define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
  80 #define ATEST(base,exp,var) var = base; call acheck((var)**(exp),(base)**(exp))
  81
  82 !!!!! INTEGER BASE !!!!!
  83   TEST(0,0,i4)
  84   TEST(0_8,0_8,i8)
  85   TEST(1,0,i4)
  86   TEST(1_8,0_8,i8)
  87   TEST(-1,0,i4)
  88   TEST(-1_8,0_8,i8)
  89   TEST(huge(0_4),0,i4)
  90   TEST(huge(0_8),0_8,i8)
  91   TEST(-huge(0_4)-1,0,i4)
  92   TEST(-huge(0_8)-1_8,0_8,i8)
  93
  94   TEST(1,1,i4)
  95   TEST(1_8,1_8,i8)
  96   TEST(1,2,i4)
  97   TEST(1_8,2_8,i8)
  98   TEST(1,-1,i4)
  99   TEST(1_8,-1_8,i8)
 100   TEST(1,-2,i4)
 101   TEST(1_8,-2_8,i8)
 102   TEST(1,huge(0),i4)
 103   TEST(1_8,huge(0_8),i8)
 104   TEST(1,-huge(0)-1,i4)
 105   TEST(1_8,-huge(0_8)-1_8,i8)
 106
 107   TEST(-1,1,i4)
 108   TEST(-1_8,1_8,i8)
 109   TEST(-1,2,i4)
 110   TEST(-1_8,2_8,i8)
 111   TEST(-1,-1,i4)
 112   TEST(-1_8,-1_8,i8)
 113   TEST(-1,-2,i4)
 114   TEST(-1_8,-2_8,i8)
 115   TEST(-1,huge(0),i4)
 116   TEST(-1_8,huge(0_8),i8)
 117   TEST(-1,-huge(0)-1,i4)
 118   TEST(-1_8,-huge(0_8)-1_8,i8)
 119
 120   TEST(2,9,i4)
 121   TEST(2_8,9_8,i8)
 122   TEST(-2,9,i4)
 123   TEST(-2_8,9_8,i8)
 124   TEST(2,-9,i4)
 125   TEST(2_8,-9_8,i8)
 126   TEST(-2,-9,i4)
 127   TEST(-2_8,-9_8,i8)
 128
 129 !!!!! REAL BASE !!!!!
 130   TEST(0.0,0,r4)
 131   TEST(0.0,1,r4)
 132   TEST(0.0,huge(0),r4)
 133   TEST(0.0,0_8,r4)
 134   TEST(0.0,1_8,r4)
 135   TEST(0.0,huge(0_8),r4)
 136
 137   TEST(1.0,0,r4)
 138   TEST(1.0,1,r4)
 139   TEST(1.0,-1,r4)
 140   TEST(1.0,huge(0),r4)
 141   TEST(1.0,-huge(0)-1,r4)
 142   TEST(1.0,0_8,r4)
 143   TEST(1.0,1_8,r4)
 144   TEST(1.0,-1_8,r4)
 145   TEST(1.0,huge(0_8),r4)
 146   TEST(1.0,-huge(0_8)-1_8,r4)
 147
 148   TEST(-1.0,0,r4)
 149   TEST(-1.0,1,r4)
 150   TEST(-1.0,-1,r4)
 151   TEST(-1.0,huge(0),r4)
 152   TEST(-1.0,-huge(0)-1,r4)
 153   TEST(-1.0,0_8,r4)
 154   TEST(-1.0,1_8,r4)
 155   TEST(-1.0,-1_8,r4)
 156   TEST(-1.0,huge(0_8),r4)
 157   TEST(-1.0,-huge(0_8)-1_8,r4)
 158
 159   TEST(2.0,0,r4)
 160   TEST(2.0,1,r4)
 161   TEST(2.0,-1,r4)
 162   TEST(2.0,3,r4)
 163   TEST(2.0,-3,r4)
 164   TEST(2.0,0_8,r4)
 165   TEST(2.0,1_8,r4)
 166   TEST(2.0,-1_8,r4)
 167   TEST(2.0,3_8,r4)
 168   TEST(2.0,-3_8,r4)
 169
 170   TEST(nearest(1.0,-1.0),0,r4)
 171   TEST(nearest(1.0,-1.0),huge(0_4),r4) ! { dg-warning "Arithmetic underflow" }
 172   TEST(nearest(1.0,-1.0),0_8,r4)
 173   TEST(nearest(1.0_8,-1.0),huge(0_8),r8) ! { dg-warning "Arithmetic underflow" }
 174
 175   TEST(nearest(1.0,-1.0),107,r4)
 176   TEST(nearest(1.0,1.0),107,r4)
 177
 178 !!!!! COMPLEX BASE !!!!!
 179   TEST((1.0,0.2),0,c4)
 180   TEST((1.0,0.2),1,c4)
 181   TEST((1.0,0.2),2,c4)
 182   ATEST((1.0,0.2),9,c4)
 183   ATEST((1.0,0.2),-1,c4)
 184   ATEST((1.0,0.2),-2,c4)
 185   ATEST((1.0,0.2),-9,c4)
 186
 187   TEST((0.0,0.2),0,c4)
 188   TEST((0.0,0.2),1,c4)
 189   TEST((0.0,0.2),2,c4)
 190   ATEST((0.0,0.2),9,c4)
 191   ATEST((0.0,0.2),-1,c4)
 192   ATEST((0.0,0.2),-2,c4)
 193   ATEST((0.0,0.2),-9,c4)
 194
 195   TEST((1.0,0.),0,c4)
 196   TEST((1.0,0.),1,c4)
 197   TEST((1.0,0.),2,c4)
 198   TEST((1.0,0.),9,c4)
 199   ATEST((1.0,0.),-1,c4)
 200   ATEST((1.0,0.),-2,c4)
 201   ATEST((1.0,0.),-9,c4)
 202
 203 end program test
 204
 205 ! { dg-final { cleanup-modules "mod_check" } }