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