Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/internal_pack_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 (2018-10-24)
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 ! Test that the internal pack and unpack routines work OK
kono
parents:
diff changeset
3 ! for different data types
kono
parents:
diff changeset
4
kono
parents:
diff changeset
5 program main
kono
parents:
diff changeset
6 integer(kind=1), dimension(3) :: i1
kono
parents:
diff changeset
7 integer(kind=2), dimension(3) :: i2
kono
parents:
diff changeset
8 integer(kind=4), dimension(3) :: i4
kono
parents:
diff changeset
9 integer(kind=8), dimension(3) :: i8
kono
parents:
diff changeset
10 real(kind=4), dimension(3) :: r4
kono
parents:
diff changeset
11 real(kind=8), dimension(3) :: r8
kono
parents:
diff changeset
12 complex(kind=4), dimension(3) :: c4
kono
parents:
diff changeset
13 complex(kind=8), dimension(3) :: c8
kono
parents:
diff changeset
14 type i8_t
kono
parents:
diff changeset
15 sequence
kono
parents:
diff changeset
16 integer(kind=8) :: v
kono
parents:
diff changeset
17 end type i8_t
kono
parents:
diff changeset
18 type(i8_t), dimension(3) :: d_i8
kono
parents:
diff changeset
19
kono
parents:
diff changeset
20 i1 = (/ -1, 1, -3 /)
kono
parents:
diff changeset
21 call sub_i1(i1(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
22 if (any(i1 /= (/ 3, 1, 2 /))) STOP 1
111
kono
parents:
diff changeset
23
kono
parents:
diff changeset
24 i2 = (/ -1, 1, -3 /)
kono
parents:
diff changeset
25 call sub_i2(i2(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
26 if (any(i2 /= (/ 3, 1, 2 /))) STOP 2
111
kono
parents:
diff changeset
27
kono
parents:
diff changeset
28 i4 = (/ -1, 1, -3 /)
kono
parents:
diff changeset
29 call sub_i4(i4(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
30 if (any(i4 /= (/ 3, 1, 2 /))) STOP 3
111
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 i8 = (/ -1, 1, -3 /)
kono
parents:
diff changeset
33 call sub_i8(i8(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
34 if (any(i8 /= (/ 3, 1, 2 /))) STOP 4
111
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 r4 = (/ -1.0, 1.0, -3.0 /)
kono
parents:
diff changeset
37 call sub_r4(r4(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
38 if (any(r4 /= (/ 3.0, 1.0, 2.0/))) STOP 5
111
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 r8 = (/ -1.0_8, 1.0_8, -3.0_8 /)
kono
parents:
diff changeset
41 call sub_r8(r8(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
42 if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) STOP 6
111
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 c4 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
kono
parents:
diff changeset
45 call sub_c4(c4(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
46 if (any(real(c4) /= (/ 3.0_4, 1.0_4, 2.0_4/))) STOP 7
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
47 if (any(aimag(c4) /= 0._4)) STOP 8
111
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 c8 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
kono
parents:
diff changeset
50 call sub_c8(c8(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
51 if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) STOP 9
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
52 if (any(aimag(c8) /= 0._4)) STOP 10
111
kono
parents:
diff changeset
53
kono
parents:
diff changeset
54 d_i8%v = (/ -1, 1, -3 /)
kono
parents:
diff changeset
55 call sub_d_i8(d_i8(1:3:2))
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
56 if (any(d_i8%v /= (/ 3, 1, 2 /))) STOP 11
111
kono
parents:
diff changeset
57
kono
parents:
diff changeset
58 end program main
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 subroutine sub_i1(i)
kono
parents:
diff changeset
61 integer(kind=1), dimension(2) :: i
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
62 if (i(1) /= -1) STOP 12
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
63 if (i(2) /= -3) STOP 13
111
kono
parents:
diff changeset
64 i(1) = 3
kono
parents:
diff changeset
65 i(2) = 2
kono
parents:
diff changeset
66 end subroutine sub_i1
kono
parents:
diff changeset
67
kono
parents:
diff changeset
68 subroutine sub_i2(i)
kono
parents:
diff changeset
69 integer(kind=2), dimension(2) :: i
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
70 if (i(1) /= -1) STOP 14
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
71 if (i(2) /= -3) STOP 15
111
kono
parents:
diff changeset
72 i(1) = 3
kono
parents:
diff changeset
73 i(2) = 2
kono
parents:
diff changeset
74 end subroutine sub_i2
kono
parents:
diff changeset
75
kono
parents:
diff changeset
76 subroutine sub_i4(i)
kono
parents:
diff changeset
77 integer(kind=4), dimension(2) :: i
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
78 if (i(1) /= -1) STOP 16
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
79 if (i(2) /= -3) STOP 17
111
kono
parents:
diff changeset
80 i(1) = 3
kono
parents:
diff changeset
81 i(2) = 2
kono
parents:
diff changeset
82 end subroutine sub_i4
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 subroutine sub_i8(i)
kono
parents:
diff changeset
85 integer(kind=8), dimension(2) :: i
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
86 if (i(1) /= -1) STOP 18
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
87 if (i(2) /= -3) STOP 19
111
kono
parents:
diff changeset
88 i(1) = 3
kono
parents:
diff changeset
89 i(2) = 2
kono
parents:
diff changeset
90 end subroutine sub_i8
kono
parents:
diff changeset
91
kono
parents:
diff changeset
92 subroutine sub_r4(r)
kono
parents:
diff changeset
93 real(kind=4), dimension(2) :: r
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
94 if (r(1) /= -1.) STOP 20
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
95 if (r(2) /= -3.) STOP 21
111
kono
parents:
diff changeset
96 r(1) = 3.
kono
parents:
diff changeset
97 r(2) = 2.
kono
parents:
diff changeset
98 end subroutine sub_r4
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 subroutine sub_r8(r)
kono
parents:
diff changeset
101 real(kind=8), dimension(2) :: r
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
102 if (r(1) /= -1._8) STOP 22
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
103 if (r(2) /= -3._8) STOP 23
111
kono
parents:
diff changeset
104 r(1) = 3._8
kono
parents:
diff changeset
105 r(2) = 2._8
kono
parents:
diff changeset
106 end subroutine sub_r8
kono
parents:
diff changeset
107
kono
parents:
diff changeset
108 subroutine sub_c8(r)
kono
parents:
diff changeset
109 implicit none
kono
parents:
diff changeset
110 complex(kind=8), dimension(2) :: r
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
111 if (r(1) /= (-1._8,0._8)) STOP 24
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
112 if (r(2) /= (-3._8,0._8)) STOP 25
111
kono
parents:
diff changeset
113 r(1) = 3._8
kono
parents:
diff changeset
114 r(2) = 2._8
kono
parents:
diff changeset
115 end subroutine sub_c8
kono
parents:
diff changeset
116
kono
parents:
diff changeset
117 subroutine sub_c4(r)
kono
parents:
diff changeset
118 implicit none
kono
parents:
diff changeset
119 complex(kind=4), dimension(2) :: r
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
120 if (r(1) /= (-1._4,0._4)) STOP 26
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
121 if (r(2) /= (-3._4,0._4)) STOP 27
111
kono
parents:
diff changeset
122 r(1) = 3._4
kono
parents:
diff changeset
123 r(2) = 2._4
kono
parents:
diff changeset
124 end subroutine sub_c4
kono
parents:
diff changeset
125
kono
parents:
diff changeset
126 subroutine sub_d_i8(i)
kono
parents:
diff changeset
127 type i8_t
kono
parents:
diff changeset
128 sequence
kono
parents:
diff changeset
129 integer(kind=8) :: v
kono
parents:
diff changeset
130 end type i8_t
kono
parents:
diff changeset
131 type(i8_t), dimension(2) :: i
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
132 if (i(1)%v /= -1) STOP 28
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
133 if (i(2)%v /= -3) STOP 29
111
kono
parents:
diff changeset
134 i(1)%v = 3
kono
parents:
diff changeset
135 i(2)%v = 2
kono
parents:
diff changeset
136 end subroutine sub_d_i8