1! { dg-do run }
2! Test that the internal pack and unpack routines work OK
3! for different data types
4
5program 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
58end program main
59
60subroutine 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
66end subroutine sub_i1
67
68subroutine 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
74end subroutine sub_i2
75
76subroutine 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
82end subroutine sub_i4
83
84subroutine 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
90end subroutine sub_i8
91
92subroutine 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.
98end subroutine sub_r4
99
100subroutine 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
106end subroutine sub_r8
107
108subroutine 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
115end subroutine sub_c8
116
117subroutine 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
124end subroutine sub_c4
125
126subroutine 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
136end subroutine sub_d_i8
137