old-autovect-branch/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90

   1 !  Check in_pack and in_unpack for integer and comlex types, with
   2 !  alignment issues thrown in for good measure.
   3
   4 program main
   5   implicit none
   6
   7   complex(kind=4) :: a4(5),b4(5),aa4(5),bb4(5)
   8   real(kind=4) :: r4(100)
   9   equivalence(a4(1),r4(1)),(b4(1),r4(12))
  10
  11   complex(kind=8) :: a8(5),b8(5),aa8(5),bb8(5)
  12   real(kind=8) :: r8(100)
  13   equivalence(a8(1),r8(1)),(b8(1),r8(12))
  14
  15   integer(kind=4) :: i4(5),ii4(5)
  16   integer(kind=8) :: i8(5),ii8(5)
  17
  18   integer :: i
  19
  20   a4 = (/(cmplx(i,-i,kind=4),i=1,5)/)
  21   b4 = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
  22   call csub4(a4(5:1:-1),b4(5:1:-1),5)
  23   aa4 = (/(cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
  24   if (any(aa4 /= a4)) call abort
  25   bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
  26   if (any(bb4 /= b4)) call abort
  27
  28   a8 = (/(cmplx(i,-i,kind=8),i=1,5)/)
  29   b8 = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
  30   call csub8(a8(5:1:-1),b8(5:1:-1),5)
  31   aa8 = (/(cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
  32   if (any(aa8 /= a8)) call abort
  33   bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
  34   if (any(bb8 /= b8)) call abort
  35
  36   i4 = (/(i, i=1,5)/)
  37   call isub4(i4(5:1:-1),5)
  38   ii4 = (/(5-i+1,i=1,5)/)
  39   if (any(ii4 /= i4)) call abort
  40
  41   i8 = (/(i,i=1,5)/)
  42   call isub8(i8(5:1:-1),5)
  43   ii8 = (/(5-i+1,i=1,5)/)
  44   if (any(ii8 /= i8)) call abort
  45
  46 end program main
  47
  48 subroutine csub4(a,b,n)
  49   implicit none
  50   complex(kind=4), dimension(n) :: a,b
  51   complex(kind=4), dimension(n) :: aa, bb
  52   integer :: n, i
  53   aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/)
  54   if (any(aa /= a)) call abort
  55   bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/)
  56   if (any(bb /= b)) call abort
  57   a = (/(cmplx(i,-i,kind=4),i=1,5)/)
  58   b = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
  59 end subroutine csub4
  60
  61 subroutine csub8(a,b,n)
  62   implicit none
  63   complex(kind=8), dimension(n) :: a,b
  64   complex(kind=8), dimension(n) :: aa, bb
  65   integer :: n, i
  66   aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/)
  67   if (any(aa /= a)) call abort
  68   bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/)
  69   if (any(bb /= b)) call abort
  70   a = (/(cmplx(i,-i,kind=8),i=1,5)/)
  71   b = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
  72 end subroutine csub8
  73
  74 subroutine isub4(a,n)
  75   implicit none
  76   integer(kind=4), dimension(n) :: a
  77   integer(kind=4), dimension(n) :: aa
  78   integer :: n, i
  79   aa = (/(n-i+1,i=1,n)/)
  80   if (any(aa /= a)) call abort
  81   a = (/(i,i=1,5)/)
  82 end subroutine isub4
  83
  84 subroutine isub8(a,n)
  85   implicit none
  86   integer(kind=8), dimension(n) :: a
  87   integer(kind=8), dimension(n) :: aa
  88   integer :: n, i
  89   aa = (/(n-i+1,i=1,n)/)
  90   if (any(aa /= a)) call abort
  91   a = (/(i,i=1,5)/)
  92 end subroutine isub8