]> git.pld-linux.org Git - packages/gdb.git/blame - gdb-vla-intel-fortran-vla-strings.patch
- up to 8.3
[packages/gdb.git] / gdb-vla-intel-fortran-vla-strings.patch
CommitLineData
4b0e5c1b
AM
1From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
2From: Fedora GDB patches <invalid@email.com>
3Date: Fri, 27 Oct 2017 21:07:50 +0200
4Subject: gdb-vla-intel-fortran-vla-strings.patch
5
4b0e5c1b
AM
6;;=push
7
140f8057
JR
8git diff --stat -p gdb/master...gdb/users/bheckel/fortran-vla-strings
90ad7d8d1a3a36c6e04e3b6d37d8825f18d595723
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 33diff --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.
45diff --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 77diff --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 348diff --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 500diff --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 590diff --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 621diff --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
644diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
645new 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
792diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
793new 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
906diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp
907new 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 1011diff --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
1051diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp
1052new 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
1159diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90
1160new 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 1203diff --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 1227diff --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 1248diff --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 1277diff --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 1306diff --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 1339diff --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);
This page took 0.333507 seconds and 4 git commands to generate.