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