Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/intrinsic_unpack_2.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 ! { dg-require-effective-target fortran_large_real }
kono
parents:
diff changeset
3 ! Program to test the UNPACK intrinsic for large real type
kono
parents:
diff changeset
4 program intrinsic_unpack
kono
parents:
diff changeset
5 implicit none
kono
parents:
diff changeset
6 integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
kono
parents:
diff changeset
7
kono
parents:
diff changeset
8 real(kind=k), dimension(3,3) :: ark, brk
kono
parents:
diff changeset
9 complex(kind=k), dimension(3,3) :: ack, bck
kono
parents:
diff changeset
10
kono
parents:
diff changeset
11 logical, dimension(3, 3) :: mask
kono
parents:
diff changeset
12 character(len=500) line1, line2
kono
parents:
diff changeset
13 integer i
kono
parents:
diff changeset
14
kono
parents:
diff changeset
15 mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
kono
parents:
diff changeset
16 &.false.,.false.,.true./), (/3, 3/));
kono
parents:
diff changeset
17
kono
parents:
diff changeset
18 ark = reshape ((/1._k, 0._k, 0._k, 0._k, 1._k, 0._k, 0._k, 0._k, 1._k/), &
kono
parents:
diff changeset
19 (/3, 3/));
kono
parents:
diff changeset
20 brk = unpack ((/2._k, 3._k, 4._k/), mask, ark)
kono
parents:
diff changeset
21 if (any (brk .ne. reshape ((/1._k, 2._k, 0._k, 3._k, 1._k, 0._k, &
kono
parents:
diff changeset
22 0._k, 0._k, 4._k/), (/3, 3/)))) &
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
23 STOP 1
111
kono
parents:
diff changeset
24 write (line1,'(9F9.5)') brk
kono
parents:
diff changeset
25 write (line2,'(9F9.5)') unpack((/2._k, 3._k, 4._k/), mask, ark)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
26 if (line1 .ne. line2) STOP 2
111
kono
parents:
diff changeset
27 brk = -1._k
kono
parents:
diff changeset
28 brk = unpack ((/2._k, 3._k, 4._k/), mask, 0._k)
kono
parents:
diff changeset
29 if (any (brk .ne. reshape ((/0._k, 2._k, 0._k, 3._k, 0._k, 0._k, &
kono
parents:
diff changeset
30 0._k, 0._k, 4._k/), (/3, 3/)))) &
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
31 STOP 3
111
kono
parents:
diff changeset
32
kono
parents:
diff changeset
33 ack = reshape ((/1._k, 0._k, 0._k, 0._k, 1._k, 0._k, 0._k, 0._k, 1._k/), &
kono
parents:
diff changeset
34 (/3, 3/));
kono
parents:
diff changeset
35 bck = unpack ((/(2._k, 0._k), (3._k, 0._k), (4._k, 0._k)/), mask, ack)
kono
parents:
diff changeset
36 if (any (real(bck) .ne. reshape ((/1._k, 2._k, 0._k, 3._k, 1._k, 0._k, &
kono
parents:
diff changeset
37 0._k, 0._k, 4._k/), (/3, 3/)))) &
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
38 STOP 4
111
kono
parents:
diff changeset
39 write (line1,'(18F9.5)') bck
kono
parents:
diff changeset
40 write (line2,'(18F9.5)') unpack((/(2._k, 0._k), (3._k, 0._k), (4._k,0._k)/), &
kono
parents:
diff changeset
41 mask, ack)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
42 if (line1 .ne. line2) STOP 5
111
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 end program