Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 @ 131:84e7813d76e9

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