gcc/testsuite/gfortran.dg/internal_pack_1.f90

   1 ! { dg-do run }
   2 ! Test that the internal pack and unpack routines work OK
   3 ! for different data types
   4
   5 program main
   6   integer(kind=1), dimension(3) :: i1
   7   integer(kind=2), dimension(3) :: i2
   8   integer(kind=4), dimension(3) :: i4
   9   integer(kind=8), dimension(3) :: i8
  10   real(kind=4), dimension(3) :: r4
  11   real(kind=8), dimension(3) :: r8
  12   complex(kind=4), dimension(3) :: c4
  13   complex(kind=8), dimension(3) :: c8
  14   type i8_t
  15      sequence
  16      integer(kind=8) :: v
  17   end type i8_t
  18   type(i8_t), dimension(3) :: d_i8
  19
  20   i1 = (/ -1, 1, -3 /)
  21   call sub_i1(i1(1:3:2))
  22   if (any(i1 /= (/ 3, 1, 2 /))) STOP 1
  23
  24   i2 = (/ -1, 1, -3 /)
  25   call sub_i2(i2(1:3:2))
  26   if (any(i2 /= (/ 3, 1, 2 /))) STOP 2
  27
  28   i4 = (/ -1, 1, -3 /)
  29   call sub_i4(i4(1:3:2))
  30   if (any(i4 /= (/ 3, 1, 2 /))) STOP 3
  31
  32   i8 = (/ -1, 1, -3 /)
  33   call sub_i8(i8(1:3:2))
  34   if (any(i8 /= (/ 3, 1, 2 /))) STOP 4
  35
  36   r4 = (/ -1.0, 1.0, -3.0 /)
  37   call sub_r4(r4(1:3:2))
  38   if (any(r4 /= (/ 3.0, 1.0, 2.0/))) STOP 5
  39
  40   r8 = (/ -1.0_8, 1.0_8, -3.0_8 /)
  41   call sub_r8(r8(1:3:2))
  42   if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) STOP 6
  43
  44   c4 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
  45   call sub_c4(c4(1:3:2))
  46   if (any(real(c4) /= (/ 3.0_4, 1.0_4, 2.0_4/))) STOP 7
  47   if (any(aimag(c4) /= 0._4)) STOP 8
  48
  49   c8 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
  50   call sub_c8(c8(1:3:2))
  51   if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) STOP 9
  52   if (any(aimag(c8) /= 0._4)) STOP 10
  53
  54   d_i8%v = (/ -1, 1, -3 /)
  55   call sub_d_i8(d_i8(1:3:2))
  56   if (any(d_i8%v /= (/ 3, 1, 2 /))) STOP 11
  57
  58 end program main
  59
  60 subroutine sub_i1(i)
  61   integer(kind=1), dimension(2) :: i
  62   if (i(1) /= -1) STOP 12
  63   if (i(2) /= -3) STOP 13
  64   i(1) = 3
  65   i(2) = 2
  66 end subroutine sub_i1
  67
  68 subroutine sub_i2(i)
  69   integer(kind=2), dimension(2) :: i
  70   if (i(1) /= -1) STOP 14
  71   if (i(2) /= -3) STOP 15
  72   i(1) = 3
  73   i(2) = 2
  74 end subroutine sub_i2
  75
  76 subroutine sub_i4(i)
  77   integer(kind=4), dimension(2) :: i
  78   if (i(1) /= -1) STOP 16
  79   if (i(2) /= -3) STOP 17
  80   i(1) = 3
  81   i(2) = 2
  82 end subroutine sub_i4
  83
  84 subroutine sub_i8(i)
  85   integer(kind=8), dimension(2) :: i
  86   if (i(1) /= -1) STOP 18
  87   if (i(2) /= -3) STOP 19
  88   i(1) = 3
  89   i(2) = 2
  90 end subroutine sub_i8
  91
  92 subroutine sub_r4(r)
  93   real(kind=4), dimension(2) :: r
  94   if (r(1) /= -1.) STOP 20
  95   if (r(2) /= -3.) STOP 21
  96   r(1) = 3.
  97   r(2) = 2.
  98 end subroutine sub_r4
  99
 100 subroutine sub_r8(r)
 101   real(kind=8), dimension(2) :: r
 102   if (r(1) /= -1._8) STOP 22
 103   if (r(2) /= -3._8) STOP 23
 104   r(1) = 3._8
 105   r(2) = 2._8
 106 end subroutine sub_r8
 107
 108 subroutine sub_c8(r)
 109   implicit none
 110   complex(kind=8), dimension(2) :: r
 111   if (r(1) /= (-1._8,0._8)) STOP 24
 112   if (r(2) /= (-3._8,0._8)) STOP 25
 113   r(1) = 3._8
 114   r(2) = 2._8
 115 end subroutine sub_c8
 116
 117 subroutine sub_c4(r)
 118   implicit none
 119   complex(kind=4), dimension(2) :: r
 120   if (r(1) /= (-1._4,0._4)) STOP 26
 121   if (r(2) /= (-3._4,0._4)) STOP 27
 122   r(1) = 3._4
 123   r(2) = 2._4
 124 end subroutine sub_c4
 125
 126 subroutine sub_d_i8(i)
 127   type i8_t
 128      sequence
 129      integer(kind=8) :: v
 130   end type i8_t
 131   type(i8_t), dimension(2) :: i
 132   if (i(1)%v /= -1) STOP 28
 133   if (i(2)%v /= -3) STOP 29
 134   i(1)%v = 3
 135   i(2)%v = 2
 136 end subroutine sub_d_i8