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