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