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 /))) call abort
23
24  i2 = (/ -1, 1, -3 /)
25  call sub_i2(i2(1:3:2))
26  if (any(i2 /= (/ 3, 1, 2 /))) call abort
27
28  i4 = (/ -1, 1, -3 /)
29  call sub_i4(i4(1:3:2))
30  if (any(i4 /= (/ 3, 1, 2 /))) call abort
31
32  i8 = (/ -1, 1, -3 /)
33  call sub_i8(i8(1:3:2))
34  if (any(i8 /= (/ 3, 1, 2 /))) call abort
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/))) call abort
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/))) call abort
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/))) call abort
47  if (any(aimag(c4) /= 0._4)) call abort
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/))) call abort
52  if (any(aimag(c8) /= 0._4)) call abort
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 /))) call abort
57
58end program main
59
60subroutine sub_i1(i)
61  integer(kind=1), dimension(2) :: i
62  if (i(1) /= -1) call abort
63  if (i(2) /= -3) call abort
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) call abort
71  if (i(2) /= -3) call abort
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) call abort
79  if (i(2) /= -3) call abort
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) call abort
87  if (i(2) /= -3) call abort
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.) call abort
95  if (r(2) /= -3.) call abort
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) call abort
103  if (r(2) /= -3._8) call abort
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)) call abort
112  if (r(2) /= (-3._8,0._8)) call abort
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)) call abort
121  if (r(2) /= (-3._4,0._4)) call abort
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) call abort
133  if (i(2)%v /= -3) call abort
134  i(1)%v = 3
135  i(2)%v = 2
136end subroutine sub_d_i8
137