]>
Commit | Line | Data |
---|---|---|
140f8057 JR |
1 | git diff --stat -p gdb/master...gdb/users/bheckel/fortran-vla-strings |
2 | 0ad7d8d1a3a36c6e04e3b6d37d8825f18d595723 | |
3 | ||
4 | gdb/NEWS | 2 + | |
5 | gdb/c-valprint.c | 22 +++++ | |
6 | gdb/dwarf2read.c | 158 +++++++++++++++++++++++++----- | |
7 | gdb/f-typeprint.c | 93 +++++++++--------- | |
8 | gdb/gdbtypes.c | 44 ++++++++- | |
9 | gdb/testsuite/gdb.cp/vla-cxx.cc | 9 ++ | |
10 | gdb/testsuite/gdb.cp/vla-cxx.exp | 9 ++ | |
11 | gdb/testsuite/gdb.fortran/pointers.exp | 143 +++++++++++++++++++++++++++ | |
12 | gdb/testsuite/gdb.fortran/pointers.f90 | 109 +++++++++++++++++++++ | |
13 | gdb/testsuite/gdb.fortran/print_type.exp | 100 +++++++++++++++++++ | |
14 | gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 +-- | |
15 | gdb/testsuite/gdb.fortran/vla-strings.exp | 103 +++++++++++++++++++ | |
16 | gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++++ | |
17 | gdb/testsuite/gdb.fortran/vla-type.exp | 7 +- | |
18 | gdb/testsuite/gdb.fortran/vla-value.exp | 12 ++- | |
19 | gdb/testsuite/gdb.mi/mi-var-child-f.exp | 7 +- | |
20 | gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 27 ++--- | |
21 | gdb/typeprint.c | 19 ++++ | |
22 | gdb/valops.c | 16 ++- | |
23 | gdb/valprint.c | 6 -- | |
24 | 20 files changed, 827 insertions(+), 110 deletions(-) | |
25 | ||
26 | Index: gdb-7.99.90.20170420/gdb/NEWS | |
27 | =================================================================== | |
28 | --- gdb-7.99.90.20170420.orig/gdb/NEWS 2017-04-20 22:27:47.076032111 +0200 | |
29 | +++ gdb-7.99.90.20170420/gdb/NEWS 2017-04-20 22:27:49.946050236 +0200 | |
30 | @@ -1,6 +1,8 @@ | |
31 | What has changed in GDB? | |
32 | (Organized release by release) | |
33 | ||
34 | +* Fortran: Support pointers to dynamic types. | |
35 | + | |
36 | *** Changes in GDB 8.0 | |
37 | ||
38 | * GDB now supports access to the PKU register on GNU/Linux. The register is | |
39 | Index: gdb-7.99.90.20170420/gdb/c-valprint.c | |
40 | =================================================================== | |
41 | --- gdb-7.99.90.20170420.orig/gdb/c-valprint.c 2017-04-20 22:27:47.077032118 +0200 | |
42 | +++ gdb-7.99.90.20170420/gdb/c-valprint.c 2017-04-20 22:27:49.947050243 +0200 | |
43 | @@ -650,6 +650,28 @@ | |
44 | else | |
45 | { | |
46 | /* normal case */ | |
47 | + if (TYPE_CODE (type) == TYPE_CODE_PTR | |
48 | + && 1 == is_dynamic_type (type)) | |
49 | + { | |
50 | + CORE_ADDR addr; | |
51 | + if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type))) | |
52 | + addr = value_address (val); | |
53 | + else | |
54 | + addr = value_as_address (val); | |
55 | + | |
56 | + /* We resolve the target-type only when the | |
57 | + pointer is associated. */ | |
58 | + if ((addr != 0) | |
59 | + && (0 == type_not_associated (type))) | |
60 | + TYPE_TARGET_TYPE (type) = | |
61 | + resolve_dynamic_type (TYPE_TARGET_TYPE (type), | |
62 | + NULL, addr); | |
63 | + } | |
64 | + else | |
65 | + { | |
66 | + /* Do nothing. References are already resolved from the beginning, | |
67 | + only pointers are resolved when we actual need the target. */ | |
68 | + } | |
69 | fprintf_filtered (stream, "("); | |
70 | type_print (value_type (val), "", stream, -1); | |
71 | fprintf_filtered (stream, ") "); | |
72 | Index: gdb-7.99.90.20170420/gdb/dwarf2read.c | |
73 | =================================================================== | |
74 | --- gdb-7.99.90.20170420.orig/gdb/dwarf2read.c 2017-04-20 22:27:47.091032206 +0200 | |
75 | +++ gdb-7.99.90.20170420/gdb/dwarf2read.c 2017-04-20 22:28:28.878296105 +0200 | |
76 | @@ -1872,7 +1872,8 @@ | |
77 | ||
78 | static int attr_to_dynamic_prop (const struct attribute *attr, | |
79 | struct die_info *die, struct dwarf2_cu *cu, | |
80 | - struct dynamic_prop *prop); | |
81 | + struct dynamic_prop *prop, const gdb_byte *additional_data, | |
82 | + int additional_data_size); | |
83 | ||
84 | /* memory allocation interface */ | |
85 | ||
86 | @@ -11557,7 +11558,7 @@ | |
87 | { | |
88 | newobj->static_link | |
89 | = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop); | |
90 | - attr_to_dynamic_prop (attr, die, cu, newobj->static_link); | |
91 | + attr_to_dynamic_prop (attr, die, cu, newobj->static_link, NULL, 0); | |
92 | } | |
93 | ||
94 | cu->list_in_scope = &local_symbols; | |
95 | @@ -14791,29 +14792,94 @@ | |
96 | struct gdbarch *gdbarch = get_objfile_arch (objfile); | |
97 | struct type *type, *range_type, *index_type, *char_type; | |
98 | struct attribute *attr; | |
99 | - unsigned int length; | |
100 | + unsigned int length = UINT_MAX; | |
101 | ||
102 | + index_type = objfile_type (objfile)->builtin_int; | |
103 | + range_type = create_static_range_type (NULL, index_type, 1, length); | |
104 | + | |
105 | + /* If DW_AT_string_length is defined, the length is stored in memory. */ | |
106 | attr = dwarf2_attr (die, DW_AT_string_length, cu); | |
107 | if (attr) | |
108 | { | |
109 | - length = DW_UNSND (attr); | |
110 | + if (attr_form_is_block (attr)) | |
111 | + { | |
112 | + struct attribute *byte_size, *bit_size; | |
113 | + struct dynamic_prop high; | |
114 | + | |
115 | + byte_size = dwarf2_attr (die, DW_AT_byte_size, cu); | |
116 | + bit_size = dwarf2_attr (die, DW_AT_bit_size, cu); | |
117 | + | |
118 | + /* DW_AT_byte_size should never occur in combination with | |
119 | + DW_AT_bit_size. */ | |
120 | + if (byte_size != NULL && bit_size != NULL) | |
121 | + complaint (&symfile_complaints, | |
122 | + _("DW_AT_byte_size AND " | |
123 | + "DW_AT_bit_size found together at the same time.")); | |
124 | + | |
125 | + /* If DW_AT_string_length AND DW_AT_byte_size exist together, | |
126 | + DW_AT_byte_size describes the number of bytes that should be read | |
127 | + from the length memory location. */ | |
128 | + if (byte_size != NULL) | |
129 | + { | |
130 | + /* Build new dwarf2_locexpr_baton structure with additions to the | |
131 | + data attribute, to reflect DWARF specialities to get address | |
132 | + sizes. */ | |
133 | + const gdb_byte append_ops[] = | |
134 | + { | |
135 | + /* DW_OP_deref_size: size of an address on the target machine | |
136 | + (bytes), where the size will be specified by the next | |
137 | + operand. */ | |
138 | + DW_OP_deref_size, | |
139 | + /* Operand for DW_OP_deref_size. */ | |
140 | + DW_UNSND(byte_size) }; | |
141 | + | |
142 | + if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops, | |
143 | + ARRAY_SIZE(append_ops))) | |
144 | + complaint (&symfile_complaints, | |
145 | + _("Could not parse DW_AT_byte_size")); | |
146 | + } | |
147 | + else if (bit_size != NULL) | |
148 | + complaint (&symfile_complaints, | |
149 | + _("DW_AT_string_length AND " | |
150 | + "DW_AT_bit_size found but not supported yet.")); | |
151 | + /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default | |
152 | + is the address size of the target machine. */ | |
153 | + else | |
154 | + { | |
155 | + const gdb_byte append_ops[] = | |
156 | + { DW_OP_deref }; | |
157 | + | |
158 | + if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops, | |
159 | + ARRAY_SIZE(append_ops))) | |
160 | + complaint (&symfile_complaints, | |
161 | + _("Could not parse DW_AT_string_length")); | |
162 | + } | |
163 | + | |
164 | + TYPE_RANGE_DATA (range_type)->high = high; | |
165 | + } | |
166 | + else | |
167 | + { | |
168 | + TYPE_HIGH_BOUND (range_type) = DW_UNSND(attr); | |
169 | + TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; | |
170 | + } | |
171 | } | |
172 | else | |
173 | { | |
174 | - /* Check for the DW_AT_byte_size attribute. */ | |
175 | + /* Check for the DW_AT_byte_size attribute, which represents the length | |
176 | + in this case. */ | |
177 | attr = dwarf2_attr (die, DW_AT_byte_size, cu); | |
178 | if (attr) | |
179 | - { | |
180 | - length = DW_UNSND (attr); | |
181 | - } | |
182 | + { | |
183 | + TYPE_HIGH_BOUND (range_type) = DW_UNSND(attr); | |
184 | + TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; | |
185 | + } | |
186 | else | |
187 | - { | |
188 | - length = 1; | |
189 | - } | |
190 | + { | |
191 | + TYPE_HIGH_BOUND (range_type) = 1; | |
192 | + TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; | |
193 | + } | |
194 | } | |
195 | ||
196 | - index_type = objfile_type (objfile)->builtin_int; | |
197 | - range_type = create_static_range_type (NULL, index_type, 1, length); | |
198 | char_type = language_string_char_type (cu->language_defn, gdbarch); | |
199 | type = create_string_type (NULL, char_type, range_type); | |
200 | ||
201 | @@ -15163,7 +15229,8 @@ | |
202 | ||
203 | static int | |
204 | attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, | |
205 | - struct dwarf2_cu *cu, struct dynamic_prop *prop) | |
206 | + struct dwarf2_cu *cu, struct dynamic_prop *prop, | |
207 | + const gdb_byte *additional_data, int additional_data_size) | |
208 | { | |
209 | struct dwarf2_property_baton *baton; | |
210 | struct obstack *obstack = &cu->objfile->objfile_obstack; | |
211 | @@ -15173,14 +15240,33 @@ | |
212 | ||
213 | if (attr_form_is_block (attr)) | |
214 | { | |
215 | - baton = XOBNEW (obstack, struct dwarf2_property_baton); | |
216 | + baton = XOBNEW(obstack, struct dwarf2_property_baton); | |
217 | baton->referenced_type = NULL; | |
218 | baton->locexpr.per_cu = cu->per_cu; | |
219 | - baton->locexpr.size = DW_BLOCK (attr)->size; | |
220 | - baton->locexpr.data = DW_BLOCK (attr)->data; | |
221 | + | |
222 | + if (additional_data != NULL && additional_data_size > 0) | |
223 | + { | |
224 | + gdb_byte *data; | |
225 | + | |
226 | + data = (gdb_byte *) obstack_alloc( | |
227 | + &cu->objfile->objfile_obstack, | |
228 | + DW_BLOCK (attr)->size + additional_data_size); | |
229 | + memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size); | |
230 | + memcpy (data + DW_BLOCK (attr)->size, additional_data, | |
231 | + additional_data_size); | |
232 | + | |
233 | + baton->locexpr.data = data; | |
234 | + baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size; | |
235 | + } | |
236 | + else | |
237 | + { | |
238 | + baton->locexpr.data = DW_BLOCK (attr)->data; | |
239 | + baton->locexpr.size = DW_BLOCK (attr)->size; | |
240 | + } | |
241 | + | |
242 | prop->data.baton = baton; | |
243 | prop->kind = PROP_LOCEXPR; | |
244 | - gdb_assert (prop->data.baton != NULL); | |
245 | + gdb_assert(prop->data.baton != NULL); | |
246 | } | |
247 | else if (attr_form_is_ref (attr)) | |
248 | { | |
249 | @@ -15213,8 +15299,28 @@ | |
250 | baton = XOBNEW (obstack, struct dwarf2_property_baton); | |
251 | baton->referenced_type = die_type (target_die, target_cu); | |
252 | baton->locexpr.per_cu = cu->per_cu; | |
253 | - baton->locexpr.size = DW_BLOCK (target_attr)->size; | |
254 | - baton->locexpr.data = DW_BLOCK (target_attr)->data; | |
255 | + | |
256 | + if (additional_data != NULL && additional_data_size > 0) | |
257 | + { | |
258 | + gdb_byte *data; | |
259 | + | |
260 | + data = (gdb_byte *) obstack_alloc (&cu->objfile->objfile_obstack, | |
261 | + DW_BLOCK (target_attr)->size + additional_data_size); | |
262 | + memcpy (data, DW_BLOCK (target_attr)->data, | |
263 | + DW_BLOCK (target_attr)->size); | |
264 | + memcpy (data + DW_BLOCK (target_attr)->size, | |
265 | + additional_data, additional_data_size); | |
266 | + | |
267 | + baton->locexpr.data = data; | |
268 | + baton->locexpr.size = (DW_BLOCK (target_attr)->size | |
269 | + + additional_data_size); | |
270 | + } | |
271 | + else | |
272 | + { | |
273 | + baton->locexpr.data = DW_BLOCK (target_attr)->data; | |
274 | + baton->locexpr.size = DW_BLOCK (target_attr)->size; | |
275 | + } | |
276 | + | |
277 | prop->data.baton = baton; | |
278 | prop->kind = PROP_LOCEXPR; | |
279 | gdb_assert (prop->data.baton != NULL); | |
280 | @@ -15325,24 +15431,24 @@ | |
281 | ||
282 | attr = dwarf2_attr (die, DW_AT_byte_stride, cu); | |
283 | if (attr) | |
284 | - if (!attr_to_dynamic_prop (attr, die, cu, &stride)) | |
285 | + if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0)) | |
286 | complaint (&symfile_complaints, _("Missing DW_AT_byte_stride " | |
287 | "- DIE at 0x%x [in module %s]"), | |
288 | to_underlying (die->sect_off), objfile_name (cu->objfile)); | |
289 | ||
290 | attr = dwarf2_attr (die, DW_AT_lower_bound, cu); | |
291 | if (attr) | |
292 | - attr_to_dynamic_prop (attr, die, cu, &low); | |
293 | + attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0); | |
294 | else if (!low_default_is_valid) | |
295 | complaint (&symfile_complaints, _("Missing DW_AT_lower_bound " | |
296 | "- DIE at 0x%x [in module %s]"), | |
297 | to_underlying (die->sect_off), objfile_name (cu->objfile)); | |
298 | ||
299 | attr = dwarf2_attr (die, DW_AT_upper_bound, cu); | |
300 | - if (!attr_to_dynamic_prop (attr, die, cu, &high)) | |
301 | + if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0)) | |
302 | { | |
303 | attr = dwarf2_attr (die, DW_AT_count, cu); | |
304 | - if (attr_to_dynamic_prop (attr, die, cu, &high)) | |
305 | + if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0)) | |
306 | { | |
307 | /* If bounds are constant do the final calculation here. */ | |
308 | if (low.kind == PROP_CONST && high.kind == PROP_CONST) | |
309 | @@ -22967,7 +23073,7 @@ | |
310 | attr = dwarf2_attr (die, DW_AT_allocated, cu); | |
311 | if (attr_form_is_block (attr)) | |
312 | { | |
313 | - if (attr_to_dynamic_prop (attr, die, cu, &prop)) | |
314 | + if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) | |
315 | add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); | |
316 | } | |
317 | else if (attr != NULL) | |
318 | @@ -22982,7 +23088,7 @@ | |
319 | attr = dwarf2_attr (die, DW_AT_associated, cu); | |
320 | if (attr_form_is_block (attr)) | |
321 | { | |
322 | - if (attr_to_dynamic_prop (attr, die, cu, &prop)) | |
323 | + if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) | |
324 | add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); | |
325 | } | |
326 | else if (attr != NULL) | |
327 | @@ -22995,7 +23101,7 @@ | |
328 | ||
329 | /* Read DW_AT_data_location and set in type. */ | |
330 | attr = dwarf2_attr (die, DW_AT_data_location, cu); | |
331 | - if (attr_to_dynamic_prop (attr, die, cu, &prop)) | |
332 | + if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) | |
333 | add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile); | |
334 | ||
335 | if (dwarf2_per_objfile->die_type_hash == NULL) | |
336 | Index: gdb-7.99.90.20170420/gdb/f-typeprint.c | |
337 | =================================================================== | |
338 | --- gdb-7.99.90.20170420.orig/gdb/f-typeprint.c 2017-04-20 22:27:26.288900835 +0200 | |
339 | +++ gdb-7.99.90.20170420/gdb/f-typeprint.c 2017-04-20 22:27:49.953050280 +0200 | |
340 | @@ -37,7 +37,7 @@ | |
341 | #endif | |
342 | ||
343 | static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int, | |
344 | - int, int, int); | |
345 | + int, int, int, int); | |
346 | ||
347 | void f_type_print_varspec_prefix (struct type *, struct ui_file *, | |
348 | int, int); | |
349 | @@ -53,18 +53,6 @@ | |
350 | { | |
351 | enum type_code code; | |
352 | ||
353 | - if (type_not_associated (type)) | |
354 | - { | |
355 | - val_print_not_associated (stream); | |
356 | - return; | |
357 | - } | |
358 | - | |
359 | - if (type_not_allocated (type)) | |
360 | - { | |
361 | - val_print_not_allocated (stream); | |
362 | - return; | |
363 | - } | |
364 | - | |
365 | f_type_print_base (type, stream, show, level); | |
366 | code = TYPE_CODE (type); | |
367 | if ((varstring != NULL && *varstring != '\0') | |
368 | @@ -89,7 +77,7 @@ | |
369 | ||
370 | demangled_args = (*varstring != '\0' | |
371 | && varstring[strlen (varstring) - 1] == ')'); | |
372 | - f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0); | |
373 | + f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0, 0); | |
374 | } | |
375 | } | |
376 | ||
377 | @@ -159,7 +147,7 @@ | |
378 | static void | |
379 | f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, | |
380 | int show, int passed_a_ptr, int demangled_args, | |
381 | - int arrayprint_recurse_level) | |
382 | + int arrayprint_recurse_level, int print_rank_only) | |
383 | { | |
384 | int upper_bound, lower_bound; | |
385 | ||
386 | @@ -183,34 +171,50 @@ | |
387 | fprintf_filtered (stream, "("); | |
388 | ||
389 | if (type_not_associated (type)) | |
390 | - val_print_not_associated (stream); | |
391 | + print_rank_only = 1; | |
392 | else if (type_not_allocated (type)) | |
393 | - val_print_not_allocated (stream); | |
394 | + print_rank_only = 1; | |
395 | + else if ((TYPE_ASSOCIATED_PROP (type) | |
396 | + && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type))) | |
397 | + || (TYPE_ALLOCATED_PROP (type) | |
398 | + && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type))) | |
399 | + || (TYPE_DATA_LOCATION (type) | |
400 | + && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type)))) | |
401 | + /* This case exist when we ptype a typename which has the | |
402 | + dynamic properties but cannot be resolved as there is | |
403 | + no object. */ | |
404 | + print_rank_only = 1; | |
405 | + | |
406 | + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) | |
407 | + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, | |
408 | + 0, 0, arrayprint_recurse_level, | |
409 | + print_rank_only); | |
410 | + | |
411 | + if (print_rank_only == 1) | |
412 | + fprintf_filtered (stream, ":"); | |
413 | else | |
414 | - { | |
415 | - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) | |
416 | - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, | |
417 | - 0, 0, arrayprint_recurse_level); | |
418 | - | |
419 | - lower_bound = f77_get_lowerbound (type); | |
420 | - if (lower_bound != 1) /* Not the default. */ | |
421 | - fprintf_filtered (stream, "%d:", lower_bound); | |
422 | - | |
423 | - /* Make sure that, if we have an assumed size array, we | |
424 | - print out a warning and print the upperbound as '*'. */ | |
425 | - | |
426 | - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) | |
427 | - fprintf_filtered (stream, "*"); | |
428 | - else | |
429 | - { | |
430 | - upper_bound = f77_get_upperbound (type); | |
431 | - fprintf_filtered (stream, "%d", upper_bound); | |
432 | - } | |
433 | - | |
434 | - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) | |
435 | - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, | |
436 | - 0, 0, arrayprint_recurse_level); | |
437 | - } | |
438 | + { | |
439 | + lower_bound = f77_get_lowerbound (type); | |
440 | + if (lower_bound != 1) /* Not the default. */ | |
441 | + fprintf_filtered (stream, "%d:", lower_bound); | |
442 | + | |
443 | + /* Make sure that, if we have an assumed size array, we | |
444 | + print out a warning and print the upperbound as '*'. */ | |
445 | + | |
446 | + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) | |
447 | + fprintf_filtered (stream, "*"); | |
448 | + else | |
449 | + { | |
450 | + upper_bound = f77_get_upperbound (type); | |
451 | + fprintf_filtered (stream, "%d", upper_bound); | |
452 | + } | |
453 | + } | |
454 | + | |
455 | + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) | |
456 | + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, | |
457 | + 0, 0, arrayprint_recurse_level, | |
458 | + print_rank_only); | |
459 | + | |
460 | if (arrayprint_recurse_level == 1) | |
461 | fprintf_filtered (stream, ")"); | |
462 | else | |
463 | @@ -221,13 +225,14 @@ | |
464 | case TYPE_CODE_PTR: | |
465 | case TYPE_CODE_REF: | |
466 | f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0, | |
467 | - arrayprint_recurse_level); | |
468 | + arrayprint_recurse_level, 0); | |
469 | fprintf_filtered (stream, ")"); | |
470 | break; | |
471 | ||
472 | case TYPE_CODE_FUNC: | |
473 | f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, | |
474 | - passed_a_ptr, 0, arrayprint_recurse_level); | |
475 | + passed_a_ptr, 0, arrayprint_recurse_level, | |
476 | + 0); | |
477 | if (passed_a_ptr) | |
478 | fprintf_filtered (stream, ")"); | |
479 | ||
480 | @@ -378,7 +383,7 @@ | |
481 | fputs_filtered (" :: ", stream); | |
482 | fputs_filtered (TYPE_FIELD_NAME (type, index), stream); | |
483 | f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index), | |
484 | - stream, show - 1, 0, 0, 0); | |
485 | + stream, show - 1, 0, 0, 0, 0); | |
486 | fputs_filtered ("\n", stream); | |
487 | } | |
488 | fprintfi_filtered (level, stream, "End Type "); | |
489 | Index: gdb-7.99.90.20170420/gdb/gdbtypes.c | |
490 | =================================================================== | |
491 | --- gdb-7.99.90.20170420.orig/gdb/gdbtypes.c 2017-04-20 22:27:47.093032219 +0200 | |
492 | +++ gdb-7.99.90.20170420/gdb/gdbtypes.c 2017-04-20 22:27:49.954050287 +0200 | |
493 | @@ -1840,7 +1840,8 @@ | |
494 | type = check_typedef (type); | |
495 | ||
496 | /* We only want to recognize references at the outermost level. */ | |
497 | - if (top_level && TYPE_CODE (type) == TYPE_CODE_REF) | |
498 | + if (top_level && | |
499 | + (TYPE_CODE (type) == TYPE_CODE_REF || TYPE_CODE (type) == TYPE_CODE_PTR)) | |
500 | type = check_typedef (TYPE_TARGET_TYPE (type)); | |
501 | ||
502 | /* Types that have a dynamic TYPE_DATA_LOCATION are considered | |
503 | @@ -1874,6 +1875,7 @@ | |
504 | } | |
505 | ||
506 | case TYPE_CODE_ARRAY: | |
507 | + case TYPE_CODE_STRING: | |
508 | { | |
509 | gdb_assert (TYPE_NFIELDS (type) == 1); | |
510 | ||
511 | @@ -1986,7 +1988,8 @@ | |
512 | struct type *ary_dim; | |
513 | struct dynamic_prop *prop; | |
514 | ||
515 | - gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); | |
516 | + gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY | |
517 | + || TYPE_CODE (type) == TYPE_CODE_STRING); | |
518 | ||
519 | type = copy_type (type); | |
520 | ||
521 | @@ -2011,13 +2014,17 @@ | |
522 | ||
523 | ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); | |
524 | ||
525 | - if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) | |
526 | + if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY | |
527 | + || TYPE_CODE (ary_dim) == TYPE_CODE_STRING)) | |
528 | elt_type = resolve_dynamic_array (ary_dim, addr_stack); | |
529 | else | |
530 | elt_type = TYPE_TARGET_TYPE (type); | |
531 | ||
532 | - return create_array_type_with_stride (type, elt_type, range_type, | |
533 | - TYPE_FIELD_BITSIZE (type, 0)); | |
534 | + if (TYPE_CODE (type) == TYPE_CODE_STRING) | |
535 | + return create_string_type (type, elt_type, range_type); | |
536 | + else | |
537 | + return create_array_type_with_stride (type, elt_type, range_type, | |
538 | + TYPE_FIELD_BITSIZE (type, 0)); | |
539 | } | |
540 | ||
541 | /* Resolve dynamic bounds of members of the union TYPE to static | |
542 | @@ -2147,6 +2154,28 @@ | |
543 | return resolved_type; | |
544 | } | |
545 | ||
546 | +/* Worker for pointer types. */ | |
547 | + | |
548 | +static struct type * | |
549 | +resolve_dynamic_pointer (struct type *type, | |
550 | + struct property_addr_info *addr_stack) | |
551 | +{ | |
552 | + struct dynamic_prop *prop; | |
553 | + CORE_ADDR value; | |
554 | + | |
555 | + type = copy_type (type); | |
556 | + | |
557 | + /* Resolve associated property. */ | |
558 | + prop = TYPE_ASSOCIATED_PROP (type); | |
559 | + if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) | |
560 | + { | |
561 | + TYPE_DYN_PROP_ADDR (prop) = value; | |
562 | + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; | |
563 | + } | |
564 | + | |
565 | + return type; | |
566 | +} | |
567 | + | |
568 | /* Worker for resolved_dynamic_type. */ | |
569 | ||
570 | static struct type * | |
571 | @@ -2195,7 +2224,12 @@ | |
572 | break; | |
573 | } | |
574 | ||
575 | + case TYPE_CODE_PTR: | |
576 | + resolved_type = resolve_dynamic_pointer (type, addr_stack); | |
577 | + break; | |
578 | + | |
579 | case TYPE_CODE_ARRAY: | |
580 | + case TYPE_CODE_STRING: | |
581 | resolved_type = resolve_dynamic_array (type, addr_stack); | |
582 | break; | |
583 | ||
584 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.cc | |
585 | =================================================================== | |
586 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.cp/vla-cxx.cc 2017-04-20 22:27:47.094032225 +0200 | |
587 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.cc 2017-04-20 22:27:49.955050293 +0200 | |
588 | @@ -15,6 +15,10 @@ | |
589 | You should have received a copy of the GNU General Public License | |
590 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ | |
591 | ||
592 | +extern "C" { | |
593 | +#include <stddef.h> | |
594 | +} | |
595 | + | |
596 | struct container; | |
597 | ||
598 | struct element | |
599 | @@ -40,11 +44,16 @@ | |
600 | typedef typeof (vla) &vlareftypedef; | |
601 | vlareftypedef vlaref2 (vla); | |
602 | container c; | |
603 | + typeof (vla) *ptr = NULL; | |
604 | + | |
605 | + // Before pointer assignment | |
606 | + ptr = &vla; | |
607 | ||
608 | for (int i = 0; i < z; ++i) | |
609 | vla[i] = 5 + 2 * i; | |
610 | ||
611 | // vlas_filled | |
612 | vla[0] = 2 * vla[0]; | |
613 | + | |
614 | return vla[2]; | |
615 | } | |
616 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.exp | |
617 | =================================================================== | |
618 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.cp/vla-cxx.exp 2017-04-20 22:27:47.094032225 +0200 | |
619 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.exp 2017-04-20 22:27:49.955050293 +0200 | |
620 | @@ -23,6 +23,12 @@ | |
621 | return -1 | |
622 | } | |
623 | ||
624 | +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] | |
625 | +gdb_continue_to_breakpoint "Before pointer assignment" | |
626 | +gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment" | |
627 | +gdb_test "print ptr" "\\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" "print ptr, Before pointer assignment" | |
628 | +gdb_test "print *ptr" "Cannot access memory at address 0x0" "print *ptr, Before pointer assignment" | |
629 | + | |
630 | gdb_breakpoint [gdb_get_line_number "vlas_filled"] | |
631 | gdb_continue_to_breakpoint "vlas_filled" | |
632 | ||
633 | @@ -33,3 +39,6 @@ | |
634 | # bug being tested, it's better not to depend on the exact spelling. | |
635 | gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}" | |
636 | gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}" | |
637 | +gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]" | |
638 | +gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex" | |
639 | +gdb_test "print *ptr" " = \\{5, 7, 9\\}" | |
640 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.exp | |
641 | =================================================================== | |
642 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
643 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.exp 2017-04-20 22:27:49.955050293 +0200 | |
644 | @@ -0,0 +1,143 @@ | |
645 | +# Copyright 2016 Free Software Foundation, Inc. | |
646 | + | |
647 | +# This program is free software; you can redistribute it and/or modify | |
648 | +# it under the terms of the GNU General Public License as published by | |
649 | +# the Free Software Foundation; either version 3 of the License, or | |
650 | +# (at your option) any later version. | |
651 | +# | |
652 | +# This program is distributed in the hope that it will be useful, | |
653 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
654 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
655 | +# GNU General Public License for more details. | |
656 | +# | |
657 | +# You should have received a copy of the GNU General Public License | |
658 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
659 | + | |
660 | +standard_testfile "pointers.f90" | |
661 | +load_lib fortran.exp | |
662 | + | |
663 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
664 | + {debug f90 quiet}] } { | |
665 | + return -1 | |
666 | +} | |
667 | + | |
668 | +if ![runto_main] { | |
669 | + untested "could not run to main" | |
670 | + return -1 | |
671 | +} | |
672 | + | |
673 | +# Depending on the compiler being used, the type names can be printed differently. | |
674 | +set logical [fortran_logical4] | |
675 | +set real [fortran_real4] | |
676 | +set int [fortran_int4] | |
677 | +set complex [fortran_complex4] | |
678 | + | |
679 | + | |
680 | +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] | |
681 | +gdb_continue_to_breakpoint "Before pointer assignment" | |
682 | +gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) 0x0" "print logp, not associated" | |
683 | +gdb_test "print *logp" "Cannot access memory at address 0x0" "print *logp, not associated" | |
684 | +gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) 0x0" "print comp, not associated" | |
685 | +gdb_test "print *comp" "Cannot access memory at address 0x0" "print *comp, not associated" | |
686 | +gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) 0x0" "print charp, not associated" | |
687 | +gdb_test "print *charp" "Cannot access memory at address 0x0" "print *charp, not associated" | |
688 | +gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) 0x0" "print charap, not associated" | |
689 | +gdb_test "print *charap" "Cannot access memory at address 0x0" "print *charap, not associated" | |
690 | +gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" "print intp, not associated" | |
691 | +gdb_test "print *intp" "Cannot access memory at address 0x0" "print *intp, not associated" | |
692 | +set test "print intap, not associated" | |
693 | +gdb_test_multiple "print intap" $test { | |
694 | + -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" { | |
695 | + pass $test | |
696 | + } | |
697 | + -re " = <not associated>\r\n$gdb_prompt $" { | |
698 | + pass $test | |
699 | + } | |
700 | +} | |
701 | +gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" "print realp, not associated" | |
702 | +gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated" | |
703 | +gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" | |
704 | +set test "print cyclicp1, not associated" | |
705 | +gdb_test_multiple "print cyclicp1" $test { | |
706 | + -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" { | |
707 | + pass $test | |
708 | + } | |
709 | + -re "= \\( i = -?\\d+, p = <not associated> \\)\r\n$gdb_prompt $" { | |
710 | + pass $test | |
711 | + } | |
712 | +} | |
713 | +set test "print cyclicp1%p, not associated" | |
714 | +gdb_test_multiple "print cyclicp1%p" $test { | |
715 | + -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0\r\n$gdb_prompt $" { | |
716 | + pass $test | |
717 | + } | |
718 | + -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) <not associated>\r\n$gdb_prompt $" { | |
719 | + pass $test | |
720 | + } | |
721 | +} | |
722 | + | |
723 | + | |
724 | +gdb_breakpoint [gdb_get_line_number "Before value assignment"] | |
725 | +gdb_continue_to_breakpoint "Before value assignment" | |
726 | +gdb_test "print *(twop)%ivla2" "= <not allocated>" | |
727 | + | |
728 | + | |
729 | +gdb_breakpoint [gdb_get_line_number "After value assignment"] | |
730 | +gdb_continue_to_breakpoint "After value assignment" | |
731 | +gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?" | |
732 | +gdb_test "print *logp" "= \\.TRUE\\." | |
733 | +gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?" | |
734 | +gdb_test "print *comp" "= \\(1,2\\)" | |
735 | +gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?" | |
736 | +gdb_test "print *charp" "= 'a'" | |
737 | +gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?" | |
738 | +gdb_test "print *charap" "= 'abc'" | |
739 | +gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?" | |
740 | +gdb_test "print *intp" "= 10" | |
741 | +set test_name "print intap, associated" | |
742 | +gdb_test_multiple "print intap" $test_name { | |
743 | + -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" { | |
744 | + pass $test_name | |
745 | + } | |
746 | + -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" { | |
747 | + gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)" | |
748 | + pass $test_name | |
749 | + } | |
750 | +} | |
751 | +set test_name "print intvlap, associated" | |
752 | +gdb_test_multiple "print intvlap" $test_name { | |
753 | + -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" { | |
754 | + pass $test_name | |
755 | + } | |
756 | + -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" { | |
757 | + gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)" | |
758 | + pass $test_name | |
759 | + } | |
760 | +} | |
761 | +gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?" | |
762 | +gdb_test "print *realp" "= 3\\.14000\\d+" | |
763 | +gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?" | |
764 | +gdb_test "print *(arrayOfPtr(2)%p)" "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)" | |
765 | +set test_name "print arrayOfPtr(3)%p" | |
766 | +gdb_test_multiple $test_name $test_name { | |
767 | + -re "= \\(PTR TO -> \\( Type two \\)\\) <not associated>\r\n$gdb_prompt $" { | |
768 | + pass $test_name | |
769 | + } | |
770 | + -re "= \\(PTR TO -> \\( Type two \\)\\) 0x0\r\n$gdb_prompt $" { | |
771 | + pass $test_name | |
772 | + } | |
773 | +} | |
774 | +set test_name "print *(arrayOfPtr(3)%p), associated" | |
775 | +gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name { | |
776 | + -re "Cannot access memory at address 0x0\r\n$gdb_prompt $" { | |
777 | + pass $test_name | |
778 | + } | |
779 | + -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" { | |
780 | + pass $test_name | |
781 | + } | |
782 | +} | |
783 | +gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)" | |
784 | +gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer \\)\\) $hex\( <.*>\)?" | |
785 | +gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array" | |
786 | +gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla" | |
787 | +gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\)\\(\\)\\)\\) $hex <pointers\\+\\d+>" "Print program counter" | |
788 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.f90 | |
789 | =================================================================== | |
790 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
791 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.f90 2017-04-20 22:27:49.955050293 +0200 | |
792 | @@ -0,0 +1,109 @@ | |
793 | +! Copyright 2016 Free Software Foundation, Inc. | |
794 | +! | |
795 | +! This program is free software; you can redistribute it and/or modify | |
796 | +! it under the terms of the GNU General Public License as published by | |
797 | +! the Free Software Foundation; either version 3 of the License, or | |
798 | +! (at your option) any later version. | |
799 | +! | |
800 | +! This program is distributed in the hope that it will be useful, | |
801 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
802 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
803 | +! GNU General Public License for more details. | |
804 | +! | |
805 | +! You should have received a copy of the GNU General Public License | |
806 | +! along with this program. If not, see <http://www.gnu.org/licenses/>. | |
807 | + | |
808 | +program pointers | |
809 | + | |
810 | + type :: two | |
811 | + integer, allocatable :: ivla1 (:) | |
812 | + integer, allocatable :: ivla2 (:, :) | |
813 | + end type two | |
814 | + | |
815 | + type :: typeWithPointer | |
816 | + integer i | |
817 | + type(typeWithPointer), pointer:: p | |
818 | + end type typeWithPointer | |
819 | + | |
820 | + type :: twoPtr | |
821 | + type (two), pointer :: p | |
822 | + end type twoPtr | |
823 | + | |
824 | + logical, target :: logv | |
825 | + complex, target :: comv | |
826 | + character, target :: charv | |
827 | + character (len=3), target :: chara | |
828 | + integer, target :: intv | |
829 | + integer, target, dimension (10,2) :: inta | |
830 | + integer, target, allocatable, dimension (:) :: intvla | |
831 | + real, target :: realv | |
832 | + type(two), target :: twov | |
833 | + type(twoPtr) :: arrayOfPtr (3) | |
834 | + type(typeWithPointer), target:: cyclicp1,cyclicp2 | |
835 | + | |
836 | + logical, pointer :: logp | |
837 | + complex, pointer :: comp | |
838 | + character, pointer:: charp | |
839 | + character (len=3), pointer:: charap | |
840 | + integer, pointer :: intp | |
841 | + integer, pointer, dimension (:,:) :: intap | |
842 | + integer, pointer, dimension (:) :: intvlap | |
843 | + real, pointer :: realp | |
844 | + type(two), pointer :: twop | |
845 | + | |
846 | + nullify (logp) | |
847 | + nullify (comp) | |
848 | + nullify (charp) | |
849 | + nullify (charap) | |
850 | + nullify (intp) | |
851 | + nullify (intap) | |
852 | + nullify (intvlap) | |
853 | + nullify (realp) | |
854 | + nullify (twop) | |
855 | + nullify (arrayOfPtr(1)%p) | |
856 | + nullify (arrayOfPtr(2)%p) | |
857 | + nullify (arrayOfPtr(3)%p) | |
858 | + nullify (cyclicp1%p) | |
859 | + nullify (cyclicp2%p) | |
860 | + | |
861 | + logp => logv ! Before pointer assignment | |
862 | + comp => comv | |
863 | + charp => charv | |
864 | + charap => chara | |
865 | + intp => intv | |
866 | + intap => inta | |
867 | + intvlap => intvla | |
868 | + realp => realv | |
869 | + twop => twov | |
870 | + arrayOfPtr(2)%p => twov | |
871 | + cyclicp1%i = 1 | |
872 | + cyclicp1%p => cyclicp2 | |
873 | + cyclicp2%i = 2 | |
874 | + cyclicp2%p => cyclicp1 | |
875 | + | |
876 | + logv = associated(logp) ! Before value assignment | |
877 | + comv = cmplx(1,2) | |
878 | + charv = "a" | |
879 | + chara = "abc" | |
880 | + intv = 10 | |
881 | + inta(:,:) = 1 | |
882 | + inta(3,1) = 3 | |
883 | + allocate (intvla(10)) | |
884 | + intvla(:) = 2 | |
885 | + intvla(4) = 4 | |
886 | + intvlap => intvla | |
887 | + realv = 3.14 | |
888 | + | |
889 | + allocate (twov%ivla1(3)) | |
890 | + allocate (twov%ivla2(2,2)) | |
891 | + twov%ivla1(1) = 11 | |
892 | + twov%ivla1(2) = 12 | |
893 | + twov%ivla1(3) = 13 | |
894 | + twov%ivla2(1,1) = 211 | |
895 | + twov%ivla2(2,1) = 221 | |
896 | + twov%ivla2(1,2) = 212 | |
897 | + twov%ivla2(2,2) = 222 | |
898 | + | |
899 | + intv = intv + 1 ! After value assignment | |
900 | + | |
901 | +end program pointers | |
902 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/print_type.exp | |
903 | =================================================================== | |
904 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
905 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/print_type.exp 2017-04-20 22:27:49.956050299 +0200 | |
906 | @@ -0,0 +1,100 @@ | |
907 | +# Copyright 2016 Free Software Foundation, Inc. | |
908 | + | |
909 | +# This program is free software; you can redistribute it and/or modify | |
910 | +# it under the terms of the GNU General Public License as published by | |
911 | +# the Free Software Foundation; either version 3 of the License, or | |
912 | +# (at your option) any later version. | |
913 | +# | |
914 | +# This program is distributed in the hope that it will be useful, | |
915 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
916 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
917 | +# GNU General Public License for more details. | |
918 | +# | |
919 | +# You should have received a copy of the GNU General Public License | |
920 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
921 | + | |
922 | +standard_testfile "pointers.f90" | |
923 | +load_lib fortran.exp | |
924 | + | |
925 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
926 | + {debug f90 quiet}] } { | |
927 | + return -1 | |
928 | +} | |
929 | + | |
930 | + | |
931 | +if ![runto_main] { | |
932 | + untested "could not run to main" | |
933 | + return -1 | |
934 | +} | |
935 | + | |
936 | +# Depending on the compiler being used, the type names can be printed differently. | |
937 | +set logical [fortran_logical4] | |
938 | +set real [fortran_real4] | |
939 | +set int [fortran_int4] | |
940 | +set complex [fortran_complex4] | |
941 | + | |
942 | +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] | |
943 | +gdb_continue_to_breakpoint "Before pointer assignment" | |
944 | +gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" "ptype logp, not associated" | |
945 | +gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" "ptype comp, not associated" | |
946 | +gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" "ptype charp, not associated" | |
947 | +gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" "ptype charap, not associated" | |
948 | +gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" "ptype intp, not associated" | |
949 | +set test "ptype intap, not associated" | |
950 | +gdb_test_multiple "ptype intap" $test { | |
951 | + -re "type = PTR TO -> \\( $int \\(:,:\\)\\)\r\n$gdb_prompt $" { | |
952 | + pass $test | |
953 | + } | |
954 | + -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" { | |
955 | + pass $test | |
956 | + } | |
957 | +} | |
958 | +gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" "ptype realp, not associated" | |
959 | +gdb_test "ptype twop" \ | |
960 | + [multi_line "type = PTR TO -> \\( Type two" \ | |
961 | + " $int :: ivla1\\(:\\)" \ | |
962 | + " $int :: ivla2\\(:,:\\)" \ | |
963 | + "End Type two \\)"] \ | |
964 | + "ptype twop, not associated" | |
965 | +gdb_test "ptype two" \ | |
966 | + [multi_line "type = Type two" \ | |
967 | + " $int :: ivla1\\(:\\)" \ | |
968 | + " $int :: ivla2\\(:,:\\)" \ | |
969 | + "End Type two"] | |
970 | + | |
971 | + | |
972 | +gdb_breakpoint [gdb_get_line_number "Before value assignment"] | |
973 | +gdb_continue_to_breakpoint "Before value assignment" | |
974 | +gdb_test "ptype twop" \ | |
975 | + [multi_line "type = PTR TO -> \\( Type two" \ | |
976 | + " $int :: ivla1\\(:\\)" \ | |
977 | + " $int :: ivla2\\(:,:\\)" \ | |
978 | + "End Type two \\)"] | |
979 | + | |
980 | + | |
981 | +gdb_breakpoint [gdb_get_line_number "After value assignment"] | |
982 | +gdb_continue_to_breakpoint "After value assignment" | |
983 | +gdb_test "ptype logv" "type = $logical" | |
984 | +gdb_test "ptype comv" "type = $complex" | |
985 | +gdb_test "ptype charv" "type = character\\*1" | |
986 | +gdb_test "ptype chara" "type = character\\*3" | |
987 | +gdb_test "ptype intv" "type = $int" | |
988 | +gdb_test "ptype inta" "type = $int \\(10,2\\)" | |
989 | +gdb_test "ptype realv" "type = $real" | |
990 | + | |
991 | + | |
992 | +gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" | |
993 | +gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" | |
994 | +gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" | |
995 | +gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" | |
996 | +gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" | |
997 | +set test "ptype intap" | |
998 | +gdb_test_multiple $test $test { | |
999 | + -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" { | |
1000 | + pass $test | |
1001 | + } | |
1002 | + -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" { | |
1003 | + pass $test | |
1004 | + } | |
1005 | +} | |
1006 | +gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" | |
1007 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp | |
1008 | =================================================================== | |
1009 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:27:47.094032225 +0200 | |
1010 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:27:49.956050299 +0200 | |
1011 | @@ -32,9 +32,9 @@ | |
1012 | # Check the ptype of various VLA states and pointer to VLA's. | |
1013 | gdb_breakpoint [gdb_get_line_number "vla1-init"] | |
1014 | gdb_continue_to_breakpoint "vla1-init" | |
1015 | -gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" | |
1016 | -gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" | |
1017 | -gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" | |
1018 | +gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not initialized" | |
1019 | +gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not initialized" | |
1020 | +gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla not initialized" | |
1021 | gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ | |
1022 | "ptype vla1(3, 6, 9) not initialized" | |
1023 | gdb_test "ptype vla2(5, 45, 20)" \ | |
1024 | @@ -81,20 +81,20 @@ | |
1025 | ||
1026 | gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] | |
1027 | gdb_continue_to_breakpoint "pvla-deassociated" | |
1028 | -gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" | |
1029 | +gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla deassociated" | |
1030 | gdb_test "ptype pvla(5, 45, 20)" \ | |
1031 | "no such vector element \\\(vector not associated\\\)" \ | |
1032 | "ptype pvla(5, 45, 20) not associated" | |
1033 | ||
1034 | gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] | |
1035 | gdb_continue_to_breakpoint "vla1-deallocated" | |
1036 | -gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" | |
1037 | +gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not allocated" | |
1038 | gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ | |
1039 | "ptype vla1(3, 6, 9) not allocated" | |
1040 | ||
1041 | gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] | |
1042 | gdb_continue_to_breakpoint "vla2-deallocated" | |
1043 | -gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" | |
1044 | +gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not allocated" | |
1045 | gdb_test "ptype vla2(5, 45, 20)" \ | |
1046 | "no such vector element \\\(vector not allocated\\\)" \ | |
1047 | "ptype vla2(5, 45, 20) not allocated" | |
1048 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.exp | |
1049 | =================================================================== | |
1050 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
1051 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.exp 2017-04-20 22:27:49.956050299 +0200 | |
1052 | @@ -0,0 +1,103 @@ | |
1053 | +# Copyright 2016 Free Software Foundation, Inc. | |
1054 | + | |
1055 | +# This program is free software; you can redistribute it and/or modify | |
1056 | +# it under the terms of the GNU General Public License as published by | |
1057 | +# the Free Software Foundation; either version 3 of the License, or | |
1058 | +# (at your option) any later version. | |
1059 | +# | |
1060 | +# This program is distributed in the hope that it will be useful, | |
1061 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1062 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1063 | +# GNU General Public License for more details. | |
1064 | +# | |
1065 | +# You should have received a copy of the GNU General Public License | |
1066 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
1067 | + | |
1068 | +standard_testfile ".f90" | |
1069 | + | |
1070 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
1071 | + {debug f90 quiet}] } { | |
1072 | + return -1 | |
1073 | +} | |
1074 | + | |
1075 | +# check that all fortran standard datatypes will be | |
1076 | +# handled correctly when using as VLA's | |
1077 | + | |
1078 | +if ![runto_main] { | |
1079 | + untested "could not run to main" | |
1080 | + return -1 | |
1081 | +} | |
1082 | + | |
1083 | +gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"] | |
1084 | +gdb_continue_to_breakpoint "var_char-allocated-1" | |
1085 | +set test "whatis var_char first time" | |
1086 | +gdb_test_multiple "whatis var_char" $test { | |
1087 | + -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" { | |
1088 | + pass $test | |
1089 | + } | |
1090 | + -re "type = character\\*10\r\n$gdb_prompt $" { | |
1091 | + pass $test | |
1092 | + } | |
1093 | +} | |
1094 | +set test "ptype var_char first time" | |
1095 | +gdb_test_multiple "ptype var_char" $test { | |
1096 | + -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" { | |
1097 | + pass $test | |
1098 | + } | |
1099 | + -re "type = character\\*10\r\n$gdb_prompt $" { | |
1100 | + pass $test | |
1101 | + } | |
1102 | +} | |
1103 | + | |
1104 | + | |
1105 | +gdb_test "next" "\\d+.*var_char = 'foo'.*" \ | |
1106 | + "next to allocation status of var_char" | |
1107 | +gdb_test "print l" " = \\.TRUE\\." "print allocation status first time" | |
1108 | + | |
1109 | + | |
1110 | +gdb_breakpoint [gdb_get_line_number "var_char-filled-1"] | |
1111 | +gdb_continue_to_breakpoint "var_char-filled-1" | |
1112 | +set test "print var_char, var_char-filled-1" | |
1113 | +gdb_test_multiple "print var_char" $test { | |
1114 | + -re "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\r\n$gdb_prompt $" { | |
1115 | + gdb_test "print *var_char" "= 'foo'" "print *var_char, var_char-filled-1" | |
1116 | + pass $test | |
1117 | + } | |
1118 | + -re "= 'foo'\r\n$gdb_prompt $" { | |
1119 | + pass $test | |
1120 | + } | |
1121 | +} | |
1122 | +set test "ptype var_char, var_char-filled-1" | |
1123 | +gdb_test_multiple "ptype var_char" $test { | |
1124 | + -re "type = PTR TO -> \\( character\\*3 \\)\r\n$gdb_prompt $" { | |
1125 | + pass $test | |
1126 | + } | |
1127 | + -re "type = character\\*3\r\n$gdb_prompt $" { | |
1128 | + pass $test | |
1129 | + } | |
1130 | +} | |
1131 | +gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)" | |
1132 | +gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)" | |
1133 | + | |
1134 | + | |
1135 | +gdb_breakpoint [gdb_get_line_number "var_char-filled-2"] | |
1136 | +gdb_continue_to_breakpoint "var_char-filled-2" | |
1137 | +set test "print var_char, var_char-filled-2" | |
1138 | +gdb_test_multiple "print var_char" $test { | |
1139 | + -re "= \\(PTR TO -> \\( character\\*6 \\)\\) $hex\r\n$gdb_prompt $" { | |
1140 | + gdb_test "print *var_char" "= 'foobar'" "print *var_char, var_char-filled-2" | |
1141 | + pass $test | |
1142 | + } | |
1143 | + -re "= 'foobar'\r\n$gdb_prompt $" { | |
1144 | + pass $test | |
1145 | + } | |
1146 | +} | |
1147 | +set test "ptype var_char, var_char-filled-2" | |
1148 | +gdb_test_multiple "ptype var_char" $test { | |
1149 | + -re "type = PTR TO -> \\( character\\*6 \\)\r\n$gdb_prompt $" { | |
1150 | + pass $test | |
1151 | + } | |
1152 | + -re "type = character\\*6\r\n$gdb_prompt $" { | |
1153 | + pass $test | |
1154 | + } | |
1155 | +} | |
1156 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.f90 | |
1157 | =================================================================== | |
1158 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
1159 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.f90 2017-04-20 22:27:49.956050299 +0200 | |
1160 | @@ -0,0 +1,39 @@ | |
1161 | +! Copyright 2016 Free Software Foundation, Inc. | |
1162 | +! | |
1163 | +! This program is free software; you can redistribute it and/or modify | |
1164 | +! it under the terms of the GNU General Public License as published by | |
1165 | +! the Free Software Foundation; either version 3 of the License, or | |
1166 | +! (at your option) any later version. | |
1167 | +! | |
1168 | +! This program is distributed in the hope that it will be useful, | |
1169 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1170 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1171 | +! GNU General Public License for more details. | |
1172 | +! | |
1173 | +! You should have received a copy of the GNU General Public License | |
1174 | +! along with this program. If not, see <http://www.gnu.org/licenses/>. | |
1175 | + | |
1176 | +program vla_strings | |
1177 | + character(len=:), target, allocatable :: var_char | |
1178 | + character(len=:), pointer :: var_char_p | |
1179 | + logical :: l | |
1180 | + | |
1181 | + allocate(character(len=10) :: var_char) | |
1182 | + l = allocated(var_char) ! var_char-allocated-1 | |
1183 | + var_char = 'foo' | |
1184 | + deallocate(var_char) ! var_char-filled-1 | |
1185 | + l = allocated(var_char) ! var_char-deallocated | |
1186 | + allocate(character(len=42) :: var_char) | |
1187 | + l = allocated(var_char) | |
1188 | + var_char = 'foobar' | |
1189 | + var_char = '' ! var_char-filled-2 | |
1190 | + var_char = 'bar' ! var_char-empty | |
1191 | + deallocate(var_char) | |
1192 | + allocate(character(len=21) :: var_char) | |
1193 | + l = allocated(var_char) ! var_char-allocated-3 | |
1194 | + var_char = 'johndoe' | |
1195 | + var_char_p => var_char | |
1196 | + l = associated(var_char_p) ! var_char_p-associated | |
1197 | + var_char_p => null() | |
1198 | + l = associated(var_char_p) ! var_char_p-not-associated | |
1199 | +end program vla_strings | |
1200 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-type.exp | |
1201 | =================================================================== | |
1202 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-type.exp 2017-04-20 22:27:47.094032225 +0200 | |
1203 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-type.exp 2017-04-20 22:27:49.956050299 +0200 | |
1204 | @@ -132,7 +132,10 @@ | |
1205 | "End Type one" ] | |
1206 | ||
1207 | # Check allocation status of dynamic array and it's dynamic members | |
1208 | -gdb_test "ptype fivedynarr" "type = <not allocated>" | |
1209 | +gdb_test "ptype fivedynarr" \ | |
1210 | + [multi_line "type = Type five" \ | |
1211 | + " Type one :: tone" \ | |
1212 | + "End Type five \\(:\\)" ] | |
1213 | gdb_test "next" "" | |
1214 | gdb_test "ptype fivedynarr(2)" \ | |
1215 | [multi_line "type = Type five" \ | |
1216 | @@ -141,7 +144,7 @@ | |
1217 | "ptype fivedynarr(2), tone is not allocated" | |
1218 | gdb_test "ptype fivedynarr(2)%tone" \ | |
1219 | [multi_line "type = Type one" \ | |
1220 | - " $int :: ivla\\(<not allocated>\\)" \ | |
1221 | + " $int :: ivla\\(:,:,:\\)" \ | |
1222 | "End Type one" ] \ | |
1223 | "ptype fivedynarr(2)%tone, not allocated" | |
1224 | ||
1225 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-value.exp | |
1226 | =================================================================== | |
1227 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-value.exp 2017-04-20 22:27:47.095032231 +0200 | |
1228 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-value.exp 2017-04-20 22:27:49.957050306 +0200 | |
1229 | @@ -14,6 +14,7 @@ | |
1230 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
1231 | ||
1232 | standard_testfile "vla.f90" | |
1233 | +load_lib "fortran.exp" | |
1234 | ||
1235 | if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \ | |
1236 | {debug f90 quiet}] } { | |
1237 | @@ -25,12 +26,15 @@ | |
1238 | return -1 | |
1239 | } | |
1240 | ||
1241 | +# Depending on the compiler being used, the type names can be printed differently. | |
1242 | +set real [fortran_real4] | |
1243 | + | |
1244 | # Try to access values in non allocated VLA | |
1245 | gdb_breakpoint [gdb_get_line_number "vla1-init"] | |
1246 | gdb_continue_to_breakpoint "vla1-init" | |
1247 | gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" | |
1248 | gdb_test "print &vla1" \ | |
1249 | - " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \ | |
1250 | + " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \ | |
1251 | "print non-allocated &vla1" | |
1252 | gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ | |
1253 | "print member in non-allocated vla1 (1)" | |
1254 | @@ -51,7 +55,7 @@ | |
1255 | "step over value assignment of vla1" | |
1256 | } | |
1257 | gdb_test "print &vla1" \ | |
1258 | - " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ | |
1259 | + " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \ | |
1260 | "print allocated &vla1" | |
1261 | gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" | |
1262 | gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)" | |
1263 | @@ -71,7 +75,7 @@ | |
1264 | # Try to access values in undefined pointer to VLA (dangling) | |
1265 | gdb_test "print pvla" " = <not associated>" "print undefined pvla" | |
1266 | gdb_test "print &pvla" \ | |
1267 | - " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \ | |
1268 | + " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \ | |
1269 | "print non-associated &pvla" | |
1270 | gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \ | |
1271 | "print undefined pvla(1,3,8)" | |
1272 | @@ -80,7 +84,7 @@ | |
1273 | gdb_breakpoint [gdb_get_line_number "pvla-associated"] | |
1274 | gdb_continue_to_breakpoint "pvla-associated" | |
1275 | gdb_test "print &pvla" \ | |
1276 | - " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ | |
1277 | + " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \ | |
1278 | "print associated &pvla" | |
1279 | gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)" | |
1280 | gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)" | |
1281 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-var-child-f.exp | |
1282 | =================================================================== | |
1283 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.mi/mi-var-child-f.exp 2017-04-20 22:27:47.095032231 +0200 | |
1284 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-var-child-f.exp 2017-04-20 22:27:49.957050306 +0200 | |
1285 | @@ -17,6 +17,7 @@ | |
1286 | ||
1287 | load_lib mi-support.exp | |
1288 | set MIFLAGS "-i=mi" | |
1289 | +load_lib "fortran.exp" | |
1290 | ||
1291 | if { [skip_fortran_tests] } { return -1 } | |
1292 | ||
1293 | @@ -40,10 +41,8 @@ | |
1294 | mi_create_varobj "array" "array" "create local variable array" | |
1295 | ||
1296 | ||
1297 | -# Depending on the compiler version being used, the name of the 4-byte integer | |
1298 | -# and real types can be printed differently. For instance, gfortran-4.1 uses | |
1299 | -# "int4" whereas gfortran-4.3 uses "integer(kind=4)". | |
1300 | -set int4 "(int4|integer\\(kind=4\\))" | |
1301 | +# Depending on the compiler being used, the type names can be printed differently. | |
1302 | +set int4 [fortran_int4] | |
1303 | ||
1304 | set children [list [list "array.-1" "-1" 2 "$int4 \\(2\\)"] \ | |
1305 | [list "array.0" "0" 2 "$int4 \\(2\\)"] \ | |
1306 | Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-vla-fortran.exp | |
1307 | =================================================================== | |
1308 | --- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2017-04-20 22:27:47.095032231 +0200 | |
1309 | +++ gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2017-04-20 22:27:49.957050306 +0200 | |
1310 | @@ -17,7 +17,9 @@ | |
1311 | # Array (VLA). | |
1312 | ||
1313 | load_lib mi-support.exp | |
1314 | +load_lib fortran.exp | |
1315 | set MIFLAGS "-i=mi" | |
1316 | +load_lib "fortran.exp" | |
1317 | ||
1318 | gdb_exit | |
1319 | if [mi_gdb_start] { | |
1320 | @@ -32,6 +34,9 @@ | |
1321 | return -1 | |
1322 | } | |
1323 | ||
1324 | +# Depending on the compiler being used, the type names can be printed differently. | |
1325 | +set real [fortran_real4] | |
1326 | + | |
1327 | mi_delete_breakpoints | |
1328 | mi_gdb_reinitialize_dir $srcdir/$subdir | |
1329 | mi_gdb_load ${binfile} | |
1330 | @@ -46,10 +51,10 @@ | |
1331 | mi_gdb_test "500-data-evaluate-expression vla1" \ | |
1332 | "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" | |
1333 | ||
1334 | -mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ | |
1335 | +mi_create_varobj_checked vla1_not_allocated vla1 "$real \\(:\\)" \ | |
1336 | "create local variable vla1_not_allocated" | |
1337 | mi_gdb_test "501-var-info-type vla1_not_allocated" \ | |
1338 | - "501\\^done,type=\"<not allocated>\"" \ | |
1339 | + "501\\^done,type=\"$real \\(:\\)\"" \ | |
1340 | "info type variable vla1_not_allocated" | |
1341 | mi_gdb_test "502-var-show-format vla1_not_allocated" \ | |
1342 | "502\\^done,format=\"natural\"" \ | |
1343 | @@ -58,7 +63,7 @@ | |
1344 | "503\\^done,value=\"\\\[0\\\]\"" \ | |
1345 | "eval variable vla1_not_allocated" | |
1346 | mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ | |
1347 | - "real\\\(kind=4\\\)" "get children of vla1_not_allocated" | |
1348 | + "$real" "get children of vla1_not_allocated" | |
1349 | ||
1350 | ||
1351 | ||
1352 | @@ -71,10 +76,10 @@ | |
1353 | mi_gdb_test "510-data-evaluate-expression vla1" \ | |
1354 | "510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla" | |
1355 | ||
1356 | -mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ | |
1357 | +mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \ | |
1358 | "create local variable vla1_allocated" | |
1359 | mi_gdb_test "511-var-info-type vla1_allocated" \ | |
1360 | - "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ | |
1361 | + "511\\^done,type=\"$real \\\(5\\\)\"" \ | |
1362 | "info type variable vla1_allocated" | |
1363 | mi_gdb_test "512-var-show-format vla1_allocated" \ | |
1364 | "512\\^done,format=\"natural\"" \ | |
1365 | @@ -83,7 +88,7 @@ | |
1366 | "513\\^done,value=\"\\\[5\\\]\"" \ | |
1367 | "eval variable vla1_allocated" | |
1368 | mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ | |
1369 | - "real\\\(kind=4\\\)" "get children of vla1_allocated" | |
1370 | + "$real" "get children of vla1_allocated" | |
1371 | ||
1372 | ||
1373 | set bp_lineno [gdb_get_line_number "vla1-filled"] | |
1374 | @@ -136,10 +141,10 @@ | |
1375 | -re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" { | |
1376 | pass $test | |
1377 | ||
1378 | - mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ | |
1379 | + mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \ | |
1380 | "create local variable pvla2_not_associated" | |
1381 | mi_gdb_test "581-var-info-type pvla2_not_associated" \ | |
1382 | - "581\\^done,type=\"<not associated>\"" \ | |
1383 | + "581\\^done,type=\"$real \\(:,:\\)\"" \ | |
1384 | "info type variable pvla2_not_associated" | |
1385 | mi_gdb_test "582-var-show-format pvla2_not_associated" \ | |
1386 | "582\\^done,format=\"natural\"" \ | |
1387 | @@ -148,7 +153,7 @@ | |
1388 | "583\\^done,value=\"\\\[0\\\]\"" \ | |
1389 | "eval variable pvla2_not_associated" | |
1390 | mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ | |
1391 | - "real\\\(kind=4\\\)" "get children of pvla2_not_associated" | |
1392 | + "$real" "get children of pvla2_not_associated" | |
1393 | } | |
1394 | -re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" { | |
1395 | # Undefined behaviour in gfortran. | |
1396 | @@ -173,9 +178,9 @@ | |
1397 | "evaluate associated vla" | |
1398 | ||
1399 | mi_create_varobj_checked pvla2_associated pvla2 \ | |
1400 | - "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" | |
1401 | + "$real \\\(5,2\\\)" "create local variable pvla2_associated" | |
1402 | mi_gdb_test "591-var-info-type pvla2_associated" \ | |
1403 | - "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ | |
1404 | + "591\\^done,type=\"$real \\\(5,2\\\)\"" \ | |
1405 | "info type variable pvla2_associated" | |
1406 | mi_gdb_test "592-var-show-format pvla2_associated" \ | |
1407 | "592\\^done,format=\"natural\"" \ | |
1408 | Index: gdb-7.99.90.20170420/gdb/typeprint.c | |
1409 | =================================================================== | |
1410 | --- gdb-7.99.90.20170420.orig/gdb/typeprint.c 2017-04-20 22:27:47.095032231 +0200 | |
1411 | +++ gdb-7.99.90.20170420/gdb/typeprint.c 2017-04-20 22:27:49.957050306 +0200 | |
1412 | @@ -474,6 +474,25 @@ | |
1413 | printf_filtered (" */\n"); | |
1414 | } | |
1415 | ||
1416 | + /* Resolve any dynamic target type, as we might print | |
1417 | + additional information about the target. | |
1418 | + For example, in Fortran and C we are printing the dimension of the | |
1419 | + dynamic array the pointer is pointing to. */ | |
1420 | + if (TYPE_CODE (type) == TYPE_CODE_PTR | |
1421 | + && is_dynamic_type (type) == 1) | |
1422 | + { | |
1423 | + CORE_ADDR addr; | |
1424 | + if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE(type))) | |
1425 | + addr = value_address (val); | |
1426 | + else | |
1427 | + addr = value_as_address (val); | |
1428 | + | |
1429 | + if (addr != 0 | |
1430 | + && type_not_associated (type) == 0) | |
1431 | + TYPE_TARGET_TYPE (type) = resolve_dynamic_type (TYPE_TARGET_TYPE (type), | |
1432 | + NULL, addr); | |
1433 | + } | |
1434 | + | |
1435 | LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags); | |
1436 | printf_filtered ("\n"); | |
1437 | ||
1438 | Index: gdb-7.99.90.20170420/gdb/valops.c | |
1439 | =================================================================== | |
1440 | --- gdb-7.99.90.20170420.orig/gdb/valops.c 2017-04-20 22:27:47.096032238 +0200 | |
1441 | +++ gdb-7.99.90.20170420/gdb/valops.c 2017-04-20 22:27:49.958050312 +0200 | |
1442 | @@ -1574,6 +1574,19 @@ | |
1443 | if (TYPE_CODE (base_type) == TYPE_CODE_PTR) | |
1444 | { | |
1445 | struct type *enc_type; | |
1446 | + CORE_ADDR addr; | |
1447 | + | |
1448 | + if (type_not_associated (base_type)) | |
1449 | + error (_("Attempt to take contents of a not associated pointer.")); | |
1450 | + | |
1451 | + if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type))) | |
1452 | + addr = value_address (arg1); | |
1453 | + else | |
1454 | + addr = value_as_address (arg1); | |
1455 | + | |
1456 | + if (addr != 0) | |
1457 | + TYPE_TARGET_TYPE (base_type) = | |
1458 | + resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), NULL, addr); | |
1459 | ||
1460 | /* We may be pointing to something embedded in a larger object. | |
1461 | Get the real type of the enclosing object. */ | |
1462 | @@ -1589,8 +1602,7 @@ | |
1463 | else | |
1464 | /* Retrieve the enclosing object pointed to. */ | |
1465 | arg2 = value_at_lazy (enc_type, | |
1466 | - (value_as_address (arg1) | |
1467 | - - value_pointed_to_offset (arg1))); | |
1468 | + (addr - value_pointed_to_offset (arg1))); | |
1469 | ||
1470 | enc_type = value_type (arg2); | |
1471 | return readjust_indirect_value_type (arg2, enc_type, base_type, arg1); | |
1472 | Index: gdb-7.99.90.20170420/gdb/valprint.c | |
1473 | =================================================================== | |
1474 | --- gdb-7.99.90.20170420.orig/gdb/valprint.c 2017-04-20 22:25:38.224218378 +0200 | |
1475 | +++ gdb-7.99.90.20170420/gdb/valprint.c 2017-04-20 22:27:49.959050318 +0200 | |
1476 | @@ -1166,12 +1166,6 @@ | |
1477 | return 0; | |
1478 | } | |
1479 | ||
1480 | - if (type_not_associated (value_type (val))) | |
1481 | - { | |
1482 | - val_print_not_associated (stream); | |
1483 | - return 0; | |
1484 | - } | |
1485 | - | |
1486 | if (type_not_allocated (value_type (val))) | |
1487 | { | |
1488 | val_print_not_allocated (stream); |