| blob | ca5fa09abb1bd3db7effc2819cf4b0b0d975d2a1 |
1 # DP: 2004-09-21 Bud Davis <bdavis9659@comcast.net>
2 # DP:
3 # DP: PR fortran/17541
4 # DP: * bld.c (ffebld_constant_new_real2_val): Fix typo,
5 # DP:
6 # DP: PR fortran/17541
7 # DP: * g77.f-torture/execute/pr17541.f: New test.
9 Index: gcc/gcc/f/bld.c
10 ===================================================================
11 RCS file: /cvs/gcc/gcc/gcc/f/Attic/bld.c,v
12 retrieving revision 1.16.14.1
13 retrieving revision 1.16.14.2
14 diff -u -r1.16.14.1 -r1.16.14.2
15 --- gcc/gcc/f/bld.c 12 Jul 2004 17:58:36 -0000 1.16.14.1
16 +++ gcc/gcc/f/bld.c 21 Sep 2004 12:54:27 -0000 1.16.14.2
17 @@ -1333,7 +1333,7 @@
18 nc = malloc_new_kp (ffebld_constant_pool(),
19 "FFEBLD_constREAL2",
20 sizeof (*nc));
21 - nc->consttype = FFEBLD_constREAL1;
22 + nc->consttype = FFEBLD_constREAL2;
23 nc->u.real2 = val;
24 nc->hook = FFECOM_constantNULL;
25 nc->llink = NULL;
26 Index: gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f
27 ===================================================================
28 RCS file: gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f
29 diff -N gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f
30 --- /dev/null 1 Jan 1970 00:00:00 -0000
31 +++ gcc/gcc/testsuite/g77.f-torture/execute/pr17541.f 21 Sep 2004 12:54:35 -0000 1.1.2.1
32 @@ -0,0 +1,202 @@
33 + program test
34 + implicit none
35 +! check all types of data statements
36 +! pr 17541
37 + real r(2)
38 + double precision s(2)
39 + integer*1 ib(2)
40 + integer*2 ih(2)
41 + integer*4 iw(2)
42 + integer*8 id(3)
43 + logical*1 lb(2)
44 + logical*2 lh(2)
45 + logical*4 lw(2)
46 + logical*8 ld(2)
47 + character*1 a(2)
48 + character*5 b(2)
49 + complex c1(2)
50 + complex*8 c2(2)
51 + data r / 1.0,2.0 /
52 + data s / 2.d0,1.d0/
53 + data ib / 1,-1 /
54 + data ih / 2,100/
55 + data iw / 4,3560000 /
56 + data id / 8,Z'ABCDEF01',Z'5555AAAA' /
57 + data a / 'a', 'z' /
58 + data b / 'xyz','abc'/
59 + data c1 /(1.0,2.0),(-1.0,-2.0)/
60 + data c2 /(1.d0,2.d0),(-1.d0,-2.d0)/
61 + data lb / .TRUE.,.FALSE. /
62 + data lh / .TRUE.,.FALSE. /
63 + data lw / .TRUE.,.FALSE. /
64 + data ld / .TRUE.,.FALSE. /
65 + logical dbug
66 + data dbug /.FALSE./
67 +! check the reals first
68 + if (r(1).ne.1.0) then
69 + if (dbug) then
70 + print*,r(1), ' should be 1.0 '
71 + else
72 + call abort
73 + endif
74 + endif
75 + if (r(2).ne.2.0) then
76 + if (dbug) then
77 + print*,r(2), ' should be 2.0 '
78 + else
79 + call abort
80 + endif
81 + endif
82 + if (s(1).ne.2.d0) then
83 + if (dbug) then
84 + print*,s(1), ' xxshould be 2.d0 '
85 + else
86 + call abort
87 + endif
88 + endif
89 + if (s(2).ne.1.d0) then
90 + if (dbug) then
91 + print*,s(2), ' should be 1.d0 '
92 + else
93 + call abort
94 + endif
95 + endif
96 +! now the integers
97 + if (ib(1).ne.1) then
98 + if (dbug) then
99 + print*,ib(1), ' should be 1 '
100 + else
101 + call abort
102 + endif
103 + endif
104 + if (ib(2).ne.-1) then
105 + if (dbug) then
106 + print*,ib(2), ' should be -1 '
107 + else
108 + call abort
109 + endif
110 + endif
111 + if (ih(1).ne.2) then
112 + if (dbug) then
113 + print*,ih(2), ' should be 2 '
114 + else
115 + call abort
116 + endif
117 + endif
118 + if (ih(2).ne.100) then
119 + if (dbug) then
120 + print*,ih(2), ' should be 100 '
121 + else
122 + call abort
123 + endif
124 + endif
125 + if (iw(1).ne.4) then
126 + if (dbug) then
127 + print*,iw(1), ' should be 4 '
128 + else
129 + call abort
130 + endif
131 + endif
132 + if (iw(2).ne.3560000) then
133 + if (dbug) then
134 + print*,iw(2), ' should be 3560000 '
135 + else
136 + call abort
137 + endif
138 + endif
139 + if (id(1).ne.8) then
140 + if (dbug) print*,id(1), ' should be 8 '
141 + call abort
142 + endif
143 + if (id(2).ne.Z'ABCDEF01') then
144 + if (dbug) print*,id(2), " should be Z'ABCDEF01' "
145 + call abort
146 + endif
147 + if (id(3).ne.Z'5555AAAA') then
148 + if (dbug) print*,id(2), " should be Z'5555AAAA' "
149 + call abort
150 + endif
151 +! complex
152 + if (c1(1).ne.(1.0,2.0)) then
153 + if (dbug) then
154 + print*,c1(1), ' should be (1.0,2.0) '
155 + else
156 + call abort
157 + endif
158 + endif
159 + if (c1(2).ne.(-1.0,-2.0)) then
160 + if (dbug) then
161 + print*,c1(2), ' should be (-1.0,-2.0) '
162 + else
163 + call abort
164 + endif
165 + endif
166 + if (c2(1).ne.(1.d0,2.d0)) then
167 + if (dbug) then
168 + print*,c2(1), ' should be (1.0,2.0) '
169 + else
170 + call abort
171 + endif
172 + endif
173 + if (c2(2).ne.(-1.d0,-2.d0)) then
174 + if (dbug) then
175 + print*,c2(2), ' should be (-1.0,-2.0) '
176 + else
177 + call abort
178 + endif
179 + endif
180 +! character
181 + if (a(1).ne.'a') then
182 + if (dbug) then
183 + print*,a(1), ' should be a '
184 + else
185 + call abort
186 + endif
187 + endif
188 + if (b(1).ne.'xyz') then
189 + if (dbug) then
190 + print*,b(1), ' should be xyz '
191 + else
192 + call abort
193 + endif
194 + endif
195 +!logicals
196 + if (.NOT.lb(1)) then
197 + if (dbug) print*,lb(1), ' should be .T. '
198 + call abort
199 + endif
200 + if (lb(2)) then
201 + if (dbug) print*,lb(2), ' should be .F. '
202 + call abort
203 + endif
204 + if (.NOT.lh(1)) then
205 + if (dbug) print*,lh(1), ' should be .T. '
206 + call abort
207 + endif
208 + if (lh(2)) then
209 + if (dbug) print*,lh(2), ' should be .F. '
210 + call abort
211 + endif
212 + if (.NOT.lw(1)) then
213 + if (dbug) print*,lw(1), ' should be .T. '
214 + call abort
215 + endif
216 + if (lw(2)) then
217 + if (dbug) print*,lw(2), ' should be .F. '
218 + call abort
219 + endif
220 + if (.NOT.ld(1)) then
221 + if (dbug) then
222 + print*,ld(1), ' should be .T. '
223 + else
224 + call abort
225 + endif
226 + endif
227 + if (ld(2)) then
228 + if (dbug) then
229 + print*,ld(2), ' should be .F. '
230 + else
231 + call abort
232 + endif
233 + endif
234 + end