1! { dg-do run }
2! Program to test the UNPACK intrinsic for the types usually present.
3program intrinsic_unpack
4   implicit none
5   integer(kind=1), dimension(3, 3) :: a1, b1
6   integer(kind=2), dimension(3, 3) :: a2, b2
7   integer(kind=4), dimension(3, 3) :: a4, b4
8   integer(kind=8), dimension(3, 3) :: a8, b8
9   real(kind=4), dimension(3,3) :: ar4, br4
10   real(kind=8), dimension(3,3) :: ar8, br8
11   complex(kind=4), dimension(3,3) :: ac4, bc4
12   complex(kind=8), dimension(3,3) :: ac8, bc8
13   type i4_t
14      integer(kind=4) :: v
15   end type i4_t
16   type(i4_t), dimension(3,3) :: at4, bt4
17   type(i4_t), dimension(3) :: vt4
18
19   logical, dimension(3, 3) :: mask
20   character(len=500) line1, line2
21   integer i
22
23   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
24                    &.false.,.false.,.true./), (/3, 3/));
25   a1 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
26   b1 = unpack ((/2_1, 3_1, 4_1/), mask, a1)
27   if (any (b1 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
28      call abort
29   write (line1,'(10I4)') b1
30   write (line2,'(10I4)') unpack((/2_1, 3_1, 4_1/), mask, a1)
31   if (line1 .ne. line2) call abort
32   b1 = -1
33   b1 = unpack ((/2_1, 3_1, 4_1/), mask, 0_1)
34   if (any (b1 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
35      call abort
36
37   a2 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
38   b2 = unpack ((/2_2, 3_2, 4_2/), mask, a2)
39   if (any (b2 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
40      call abort
41   write (line1,'(10I4)') b2
42   write (line2,'(10I4)') unpack((/2_2, 3_2, 4_2/), mask, a2)
43   if (line1 .ne. line2) call abort
44   b2 = -1
45   b2 = unpack ((/2_2, 3_2, 4_2/), mask, 0_2)
46   if (any (b2 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
47      call abort
48
49   a4 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
50   b4 = unpack ((/2_4, 3_4, 4_4/), mask, a4)
51   if (any (b4 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
52      call abort
53   write (line1,'(10I4)') b4
54   write (line2,'(10I4)') unpack((/2_4, 3_4, 4_4/), mask, a4)
55   if (line1 .ne. line2) call abort
56   b4 = -1
57   b4 = unpack ((/2_4, 3_4, 4_4/), mask, 0_4)
58   if (any (b4 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
59      call abort
60
61   a8 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
62   b8 = unpack ((/2_8, 3_8, 4_8/), mask, a8)
63   if (any (b8 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
64      call abort
65   write (line1,'(10I4)') b8
66   write (line2,'(10I4)') unpack((/2_8, 3_8, 4_8/), mask, a8)
67   if (line1 .ne. line2) call abort
68   b8 = -1
69   b8 = unpack ((/2_8, 3_8, 4_8/), mask, 0_8)
70   if (any (b8 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
71      call abort
72
73   ar4 = reshape ((/1._4, 0._4, 0._4, 0._4, 1._4, 0._4, 0._4, 0._4, 1._4/), &
74         (/3, 3/));
75   br4 = unpack ((/2._4, 3._4, 4._4/), mask, ar4)
76   if (any (br4 .ne. reshape ((/1._4, 2._4, 0._4, 3._4, 1._4, 0._4, &
77                               0._4, 0._4, 4._4/), (/3, 3/)))) &
78      call abort
79   write (line1,'(9F9.5)') br4
80   write (line2,'(9F9.5)') unpack((/2._4, 3._4, 4._4/), mask, ar4)
81   if (line1 .ne. line2) call abort
82   br4 = -1._4
83   br4 = unpack ((/2._4, 3._4, 4._4/), mask, 0._4)
84   if (any (br4 .ne. reshape ((/0._4, 2._4, 0._4, 3._4, 0._4, 0._4, &
85      0._4, 0._4, 4._4/), (/3, 3/)))) &
86      call abort
87
88   ar8 = reshape ((/1._8, 0._8, 0._8, 0._8, 1._8, 0._8, 0._8, 0._8, 1._8/), &
89         (/3, 3/));
90   br8 = unpack ((/2._8, 3._8, 4._8/), mask, ar8)
91   if (any (br8 .ne. reshape ((/1._8, 2._8, 0._8, 3._8, 1._8, 0._8, &
92                               0._8, 0._8, 4._8/), (/3, 3/)))) &
93      call abort
94   write (line1,'(9F9.5)') br8
95   write (line2,'(9F9.5)') unpack((/2._8, 3._8, 4._8/), mask, ar8)
96   if (line1 .ne. line2) call abort
97   br8 = -1._8
98   br8 = unpack ((/2._8, 3._8, 4._8/), mask, 0._8)
99   if (any (br8 .ne. reshape ((/0._8, 2._8, 0._8, 3._8, 0._8, 0._8, &
100      0._8, 0._8, 4._8/), (/3, 3/)))) &
101      call abort
102
103   ac4 = reshape ((/1._4, 0._4, 0._4, 0._4, 1._4, 0._4, 0._4, 0._4, 1._4/), &
104        (/3, 3/));
105   bc4 = unpack ((/(2._4, 0._4), (3._4, 0._4), (4._4,   0._4)/), mask, ac4)
106   if (any (real(bc4) .ne. reshape ((/1._4, 2._4, 0._4, 3._4, 1._4, 0._4, &
107        0._4, 0._4, 4._4/), (/3, 3/)))) &
108        call abort
109   write (line1,'(18F9.5)') bc4
110   write (line2,'(18F9.5)') unpack((/(2._4, 0._4), (3._4, 0._4), (4._4,0._4)/), &
111        mask, ac4)
112   if (line1 .ne. line2) call abort
113
114   ac8 = reshape ((/1._8, 0._8, 0._8, 0._8, 1._8, 0._8, 0._8, 0._8, 1._8/), &
115        (/3, 3/));
116   bc8 = unpack ((/(2._8, 0._8), (3._8, 0._8), (4._8,   0._8)/), mask, ac8)
117   if (any (real(bc8) .ne. reshape ((/1._8, 2._8, 0._8, 3._8, 1._8, 0._8, &
118        0._8, 0._8, 4._8/), (/3, 3/)))) &
119        call abort
120   write (line1,'(18F9.5)') bc8
121   write (line2,'(18F9.5)') unpack((/(2._8, 0._8), (3._8, 0._8), (4._8,0._8)/), &
122        mask, ac8)
123   if (line1 .ne. line2) call abort
124
125   at4%v = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
126   vt4%v = (/2_4, 3_4, 4_4/)
127   bt4 = unpack (vt4, mask, at4)
128   if (any (bt4%v .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
129      call abort
130   bt4%v = -1
131   bt4 = unpack (vt4, mask, i4_t(0_4))
132   if (any (bt4%v .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
133        call abort
134
135end program
136