]>
Commit | Line | Data |
---|---|---|
aa964043 KK |
1 | [PATCH 00/23] Fortran dynamic array support |
2 | https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html | |
3 | https://github.com/intel-gdb/vla/tree/vla-fortran | |
4 | ||
5 | GIT snapshot: | |
6 | commit 511bff520372ffc10fa2ff569c176bdf1e6e475d | |
7 | ||
8 | ||
28b292e9 | 9 | Index: gdb-7.10.50.20160106/gdb/c-valprint.c |
b1b25d28 | 10 | =================================================================== |
28b292e9 AM |
11 | --- gdb-7.10.50.20160106.orig/gdb/c-valprint.c 2016-01-08 19:15:35.065582359 +0100 |
12 | +++ gdb-7.10.50.20160106/gdb/c-valprint.c 2016-01-08 19:15:44.974637630 +0100 | |
13 | @@ -642,7 +642,16 @@ | |
aa964043 KK |
14 | { |
15 | /* normal case */ | |
16 | fprintf_filtered (stream, "("); | |
17 | - type_print (value_type (val), "", stream, -1); | |
18 | + if (is_dynamic_type (TYPE_TARGET_TYPE (type))) | |
19 | + { | |
20 | + struct value *v; | |
21 | + | |
22 | + v = value_ind (val); | |
23 | + v = value_addr (v); | |
24 | + type_print (value_type (v), "", stream, -1); | |
25 | + } | |
26 | + else | |
27 | + type_print (value_type (val), "", stream, -1); | |
28 | fprintf_filtered (stream, ") "); | |
29 | } | |
30 | } | |
28b292e9 | 31 | Index: gdb-7.10.50.20160106/gdb/dwarf2loc.h |
b1b25d28 | 32 | =================================================================== |
28b292e9 AM |
33 | --- gdb-7.10.50.20160106.orig/gdb/dwarf2loc.h 2016-01-08 19:15:35.066582365 +0100 |
34 | +++ gdb-7.10.50.20160106/gdb/dwarf2loc.h 2016-01-08 19:15:44.974637630 +0100 | |
35 | @@ -138,6 +138,11 @@ | |
324d13e1 | 36 | struct property_addr_info *addr_stack, |
aa964043 KK |
37 | CORE_ADDR *value); |
38 | ||
aa964043 KK |
39 | +/* Checks if a dwarf location definition is valid. |
40 | + Returns 1 if valid; 0 otherwise. */ | |
41 | + | |
42 | +extern int dwarf2_address_data_valid (const struct type *type); | |
43 | + | |
b1b25d28 JR |
44 | /* A helper for the compiler interface that compiles a single dynamic |
45 | property to C code. | |
aa964043 | 46 | |
28b292e9 | 47 | Index: gdb-7.10.50.20160106/gdb/dwarf2read.c |
b1b25d28 | 48 | =================================================================== |
28b292e9 AM |
49 | --- gdb-7.10.50.20160106.orig/gdb/dwarf2read.c 2016-01-08 19:15:35.078582432 +0100 |
50 | +++ gdb-7.10.50.20160106/gdb/dwarf2read.c 2016-01-08 19:15:44.980637663 +0100 | |
51 | @@ -1745,7 +1745,9 @@ | |
b1b25d28 | 52 | |
28b292e9 AM |
53 | static int attr_to_dynamic_prop (const struct attribute *attr, |
54 | struct die_info *die, struct dwarf2_cu *cu, | |
55 | - struct dynamic_prop *prop); | |
56 | + struct dynamic_prop *prop, | |
57 | + const gdb_byte *additional_data, | |
58 | + int additional_data_size); | |
59 | ||
60 | /* memory allocation interface */ | |
61 | ||
62 | @@ -11420,7 +11422,7 @@ | |
63 | { | |
64 | newobj->static_link | |
65 | = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop); | |
66 | - attr_to_dynamic_prop (attr, die, cu, newobj->static_link); | |
67 | + attr_to_dynamic_prop (attr, die, cu, newobj->static_link, NULL, 0); | |
68 | } | |
aa964043 | 69 | |
28b292e9 AM |
70 | cu->list_in_scope = &local_symbols; |
71 | @@ -14471,29 +14473,92 @@ | |
aa964043 KK |
72 | struct gdbarch *gdbarch = get_objfile_arch (objfile); |
73 | struct type *type, *range_type, *index_type, *char_type; | |
74 | struct attribute *attr; | |
75 | - unsigned int length; | |
76 | + unsigned int length = UINT_MAX; | |
b1b25d28 | 77 | |
aa964043 KK |
78 | + index_type = objfile_type (objfile)->builtin_int; |
79 | + range_type = create_static_range_type (NULL, index_type, 1, length); | |
b1b25d28 | 80 | + |
aa964043 KK |
81 | + /* If DW_AT_string_length is defined, the length is stored at some location |
82 | + * in memory. */ | |
83 | attr = dwarf2_attr (die, DW_AT_string_length, cu); | |
84 | if (attr) | |
85 | { | |
86 | - length = DW_UNSND (attr); | |
87 | + if (attr_form_is_block (attr)) | |
88 | + { | |
89 | + struct attribute *byte_size, *bit_size; | |
90 | + struct dynamic_prop high; | |
91 | + | |
92 | + byte_size = dwarf2_attr (die, DW_AT_byte_size, cu); | |
93 | + bit_size = dwarf2_attr (die, DW_AT_bit_size, cu); | |
94 | + | |
95 | + /* DW_AT_byte_size should never occur together in combination with | |
96 | + DW_AT_string_length. */ | |
97 | + if ((byte_size == NULL && bit_size != NULL) || | |
98 | + (byte_size != NULL && bit_size == NULL)) | |
99 | + complaint (&symfile_complaints, _("DW_AT_byte_size AND " | |
100 | + "DW_AT_bit_size found together at the same time.")); | |
101 | + | |
102 | + /* If DW_AT_string_length AND DW_AT_byte_size exist together, it | |
103 | + describes the number of bytes that should be read from the length | |
104 | + memory location. */ | |
105 | + if (byte_size != NULL && bit_size == NULL) | |
106 | + { | |
107 | + /* Build new dwarf2_locexpr_baton structure with additions to the | |
108 | + data attribute, to reflect DWARF specialities to get address | |
109 | + sizes. */ | |
110 | + const gdb_byte append_ops[] = { | |
111 | + /* DW_OP_deref_size: size of an address on the target machine | |
112 | + (bytes), where the size will be specified by the next | |
113 | + operand. */ | |
114 | + DW_OP_deref_size, | |
115 | + /* Operand for DW_OP_deref_size. */ | |
116 | + DW_UNSND (byte_size) }; | |
117 | + | |
118 | + if (!attr_to_dynamic_prop (attr, die, cu, &high, | |
119 | + append_ops, ARRAY_SIZE (append_ops))) | |
120 | + complaint (&symfile_complaints, | |
121 | + _("Could not parse DW_AT_byte_size")); | |
122 | + } | |
123 | + else if (bit_size != NULL && byte_size == NULL) | |
124 | + complaint (&symfile_complaints, _("DW_AT_string_length AND " | |
125 | + "DW_AT_bit_size found but not supported yet.")); | |
126 | + /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default | |
127 | + is the address size of the target machine. */ | |
128 | + else | |
129 | + { | |
130 | + const gdb_byte append_ops[] = { DW_OP_deref }; | |
131 | + | |
132 | + if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops, | |
133 | + ARRAY_SIZE (append_ops))) | |
134 | + complaint (&symfile_complaints, | |
135 | + _("Could not parse DW_AT_string_length")); | |
136 | + } | |
137 | + | |
138 | + TYPE_RANGE_DATA (range_type)->high = high; | |
139 | + } | |
140 | + else | |
141 | + { | |
142 | + TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr); | |
143 | + TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; | |
144 | + } | |
145 | } | |
146 | else | |
147 | { | |
148 | - /* Check for the DW_AT_byte_size attribute. */ | |
149 | + /* Check for the DW_AT_byte_size attribute, which represents the length | |
150 | + in this case. */ | |
151 | attr = dwarf2_attr (die, DW_AT_byte_size, cu); | |
152 | if (attr) | |
153 | { | |
154 | - length = DW_UNSND (attr); | |
155 | + TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr); | |
156 | + TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; | |
157 | } | |
158 | else | |
159 | { | |
160 | - length = 1; | |
161 | + TYPE_HIGH_BOUND (range_type) = 1; | |
162 | + TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; | |
163 | } | |
164 | } | |
165 | ||
166 | - index_type = objfile_type (objfile)->builtin_int; | |
167 | - range_type = create_static_range_type (NULL, index_type, 1, length); | |
168 | char_type = language_string_char_type (cu->language_defn, gdbarch); | |
169 | type = create_string_type (NULL, char_type, range_type); | |
170 | ||
28b292e9 | 171 | @@ -14816,13 +14881,15 @@ |
aa964043 KK |
172 | return set_die_type (die, type, cu); |
173 | } | |
174 | ||
175 | + | |
176 | /* Parse dwarf attribute if it's a block, reference or constant and put the | |
177 | resulting value of the attribute into struct bound_prop. | |
178 | Returns 1 if ATTR could be resolved into PROP, 0 otherwise. */ | |
179 | ||
180 | static int | |
181 | attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, | |
182 | - struct dwarf2_cu *cu, struct dynamic_prop *prop) | |
183 | + struct dwarf2_cu *cu, struct dynamic_prop *prop, | |
184 | + const gdb_byte *additional_data, int additional_data_size) | |
185 | { | |
186 | struct dwarf2_property_baton *baton; | |
187 | struct obstack *obstack = &cu->objfile->objfile_obstack; | |
28b292e9 AM |
188 | @@ -14835,8 +14902,25 @@ |
189 | baton = XOBNEW (obstack, struct dwarf2_property_baton); | |
aa964043 KK |
190 | baton->referenced_type = NULL; |
191 | baton->locexpr.per_cu = cu->per_cu; | |
192 | - baton->locexpr.size = DW_BLOCK (attr)->size; | |
193 | - baton->locexpr.data = DW_BLOCK (attr)->data; | |
194 | + | |
195 | + if (additional_data != NULL && additional_data_size > 0) | |
196 | + { | |
197 | + gdb_byte *data; | |
198 | + | |
199 | + data = obstack_alloc (&cu->objfile->objfile_obstack, | |
200 | + DW_BLOCK (attr)->size + additional_data_size); | |
201 | + memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size); | |
202 | + memcpy (data + DW_BLOCK (attr)->size, | |
203 | + additional_data, additional_data_size); | |
204 | + | |
205 | + baton->locexpr.data = data; | |
206 | + baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size; | |
207 | + } | |
208 | + else | |
209 | + { | |
210 | + baton->locexpr.data = DW_BLOCK (attr)->data; | |
211 | + baton->locexpr.size = DW_BLOCK (attr)->size; | |
212 | + } | |
213 | prop->data.baton = baton; | |
214 | prop->kind = PROP_LOCEXPR; | |
215 | gdb_assert (prop->data.baton != NULL); | |
28b292e9 AM |
216 | @@ -14872,8 +14956,28 @@ |
217 | baton = XOBNEW (obstack, struct dwarf2_property_baton); | |
324d13e1 JR |
218 | baton->referenced_type = die_type (target_die, target_cu); |
219 | baton->locexpr.per_cu = cu->per_cu; | |
220 | - baton->locexpr.size = DW_BLOCK (target_attr)->size; | |
221 | - baton->locexpr.data = DW_BLOCK (target_attr)->data; | |
222 | + | |
223 | + if (additional_data != NULL && additional_data_size > 0) | |
224 | + { | |
225 | + gdb_byte *data; | |
226 | + | |
227 | + data = obstack_alloc (&cu->objfile->objfile_obstack, | |
228 | + DW_BLOCK (target_attr)->size + additional_data_size); | |
229 | + memcpy (data, DW_BLOCK (target_attr)->data, | |
230 | + DW_BLOCK (target_attr)->size); | |
231 | + memcpy (data + DW_BLOCK (target_attr)->size, | |
232 | + additional_data, additional_data_size); | |
233 | + | |
234 | + baton->locexpr.data = data; | |
235 | + baton->locexpr.size = (DW_BLOCK (target_attr)->size | |
236 | + + additional_data_size); | |
237 | + } | |
238 | + else | |
239 | + { | |
240 | + baton->locexpr.data = DW_BLOCK (target_attr)->data; | |
241 | + baton->locexpr.size = DW_BLOCK (target_attr)->size; | |
242 | + } | |
243 | + | |
244 | prop->data.baton = baton; | |
245 | prop->kind = PROP_LOCEXPR; | |
246 | gdb_assert (prop->data.baton != NULL); | |
28b292e9 | 247 | @@ -14927,7 +15031,7 @@ |
aa964043 KK |
248 | struct type *base_type, *orig_base_type; |
249 | struct type *range_type; | |
250 | struct attribute *attr; | |
251 | - struct dynamic_prop low, high; | |
252 | + struct dynamic_prop low, high, stride; | |
253 | int low_default_is_valid; | |
254 | int high_bound_is_count = 0; | |
255 | const char *name; | |
28b292e9 | 256 | @@ -14947,7 +15051,9 @@ |
aa964043 KK |
257 | |
258 | low.kind = PROP_CONST; | |
259 | high.kind = PROP_CONST; | |
260 | + stride.kind = PROP_CONST; | |
261 | high.data.const_val = 0; | |
262 | + stride.data.const_val = 0; | |
263 | ||
264 | /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow | |
265 | omitting DW_AT_lower_bound. */ | |
28b292e9 | 266 | @@ -14980,19 +15086,26 @@ |
aa964043 KK |
267 | break; |
268 | } | |
269 | ||
270 | + attr = dwarf2_attr (die, DW_AT_byte_stride, cu); | |
271 | + if (attr) | |
272 | + if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0)) | |
273 | + complaint (&symfile_complaints, _("Missing DW_AT_byte_stride " | |
274 | + "- DIE at 0x%x [in module %s]"), | |
275 | + die->offset.sect_off, objfile_name (cu->objfile)); | |
276 | + | |
277 | attr = dwarf2_attr (die, DW_AT_lower_bound, cu); | |
278 | if (attr) | |
279 | - attr_to_dynamic_prop (attr, die, cu, &low); | |
280 | + attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0); | |
281 | else if (!low_default_is_valid) | |
282 | complaint (&symfile_complaints, _("Missing DW_AT_lower_bound " | |
283 | "- DIE at 0x%x [in module %s]"), | |
284 | die->offset.sect_off, objfile_name (cu->objfile)); | |
285 | ||
286 | attr = dwarf2_attr (die, DW_AT_upper_bound, cu); | |
287 | - if (!attr_to_dynamic_prop (attr, die, cu, &high)) | |
288 | + if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0)) | |
289 | { | |
290 | attr = dwarf2_attr (die, DW_AT_count, cu); | |
291 | - if (attr_to_dynamic_prop (attr, die, cu, &high)) | |
292 | + if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0)) | |
293 | { | |
294 | /* If bounds are constant do the final calculation here. */ | |
295 | if (low.kind == PROP_CONST && high.kind == PROP_CONST) | |
28b292e9 | 296 | @@ -15056,7 +15169,7 @@ |
aa964043 KK |
297 | && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask)) |
298 | high.data.const_val |= negative_mask; | |
299 | ||
300 | - range_type = create_range_type (NULL, orig_base_type, &low, &high); | |
301 | + range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride); | |
302 | ||
303 | if (high_bound_is_count) | |
304 | TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1; | |
28b292e9 AM |
305 | @@ -22360,7 +22473,7 @@ |
306 | attr = dwarf2_attr (die, DW_AT_allocated, cu); | |
307 | if (attr_form_is_block (attr)) | |
308 | { | |
309 | - if (attr_to_dynamic_prop (attr, die, cu, &prop)) | |
aa964043 | 310 | + if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) |
28b292e9 AM |
311 | add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); |
312 | } | |
313 | else if (attr != NULL) | |
314 | @@ -22375,7 +22488,7 @@ | |
315 | attr = dwarf2_attr (die, DW_AT_associated, cu); | |
316 | if (attr_form_is_block (attr)) | |
317 | { | |
318 | - if (attr_to_dynamic_prop (attr, die, cu, &prop)) | |
aa964043 | 319 | + if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) |
28b292e9 AM |
320 | add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); |
321 | } | |
322 | else if (attr != NULL) | |
323 | @@ -22388,7 +22501,7 @@ | |
324 | ||
324d13e1 JR |
325 | /* Read DW_AT_data_location and set in type. */ |
326 | attr = dwarf2_attr (die, DW_AT_data_location, cu); | |
327 | - if (attr_to_dynamic_prop (attr, die, cu, &prop)) | |
aa964043 | 328 | + if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) |
324d13e1 JR |
329 | add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile); |
330 | ||
331 | if (dwarf2_per_objfile->die_type_hash == NULL) | |
28b292e9 | 332 | Index: gdb-7.10.50.20160106/gdb/f-typeprint.c |
b1b25d28 | 333 | =================================================================== |
28b292e9 AM |
334 | --- gdb-7.10.50.20160106.orig/gdb/f-typeprint.c 2016-01-08 19:15:35.080582443 +0100 |
335 | +++ gdb-7.10.50.20160106/gdb/f-typeprint.c 2016-01-08 19:15:44.980637663 +0100 | |
336 | @@ -31,6 +31,7 @@ | |
aa964043 KK |
337 | #include "target.h" |
338 | #include "f-lang.h" | |
28b292e9 | 339 | #include "typeprint.h" |
aa964043 KK |
340 | +#include "valprint.h" |
341 | ||
b1b25d28 JR |
342 | #if 0 /* Currently unused. */ |
343 | static void f_type_print_args (struct type *, struct ui_file *); | |
28b292e9 AM |
344 | @@ -64,6 +65,17 @@ |
345 | { | |
346 | val_print_not_allocated (stream); | |
347 | return; | |
348 | + } | |
349 | + | |
aa964043 KK |
350 | + if (TYPE_NOT_ASSOCIATED (type)) |
351 | + { | |
352 | + val_print_not_associated (stream); | |
353 | + return; | |
354 | + } | |
355 | + if (TYPE_NOT_ALLOCATED (type)) | |
356 | + { | |
357 | + val_print_not_allocated (stream); | |
358 | + return; | |
28b292e9 AM |
359 | } |
360 | ||
aa964043 | 361 | f_type_print_base (type, stream, show, level); |
28b292e9 | 362 | Index: gdb-7.10.50.20160106/gdb/f-valprint.c |
b1b25d28 | 363 | =================================================================== |
28b292e9 AM |
364 | --- gdb-7.10.50.20160106.orig/gdb/f-valprint.c 2016-01-08 19:15:35.081582448 +0100 |
365 | +++ gdb-7.10.50.20160106/gdb/f-valprint.c 2016-01-08 19:15:44.981637669 +0100 | |
b1b25d28 | 366 | @@ -36,8 +36,6 @@ |
aa964043 KK |
367 | |
368 | extern void _initialize_f_valprint (void); | |
369 | static void info_common_command (char *, int); | |
370 | -static void f77_create_arrayprint_offset_tbl (struct type *, | |
371 | - struct ui_file *); | |
372 | static void f77_get_dynamic_length_of_aggregate (struct type *); | |
373 | ||
374 | int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2]; | |
28b292e9 | 375 | @@ -45,15 +43,6 @@ |
aa964043 KK |
376 | /* Array which holds offsets to be applied to get a row's elements |
377 | for a given array. Array also holds the size of each subarray. */ | |
378 | ||
379 | -/* The following macro gives us the size of the nth dimension, Where | |
380 | - n is 1 based. */ | |
381 | - | |
382 | -#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1]) | |
383 | - | |
384 | -/* The following gives us the offset for row n where n is 1-based. */ | |
385 | - | |
386 | -#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0]) | |
387 | - | |
388 | int | |
389 | f77_get_lowerbound (struct type *type) | |
390 | { | |
28b292e9 | 391 | @@ -111,47 +100,6 @@ |
aa964043 KK |
392 | * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type))); |
393 | } | |
394 | ||
395 | -/* Function that sets up the array offset,size table for the array | |
396 | - type "type". */ | |
397 | - | |
398 | -static void | |
399 | -f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream) | |
400 | -{ | |
401 | - struct type *tmp_type; | |
402 | - int eltlen; | |
403 | - int ndimen = 1; | |
404 | - int upper, lower; | |
405 | - | |
406 | - tmp_type = type; | |
407 | - | |
408 | - while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY) | |
409 | - { | |
410 | - upper = f77_get_upperbound (tmp_type); | |
411 | - lower = f77_get_lowerbound (tmp_type); | |
412 | - | |
413 | - F77_DIM_SIZE (ndimen) = upper - lower + 1; | |
414 | - | |
415 | - tmp_type = TYPE_TARGET_TYPE (tmp_type); | |
416 | - ndimen++; | |
417 | - } | |
418 | - | |
419 | - /* Now we multiply eltlen by all the offsets, so that later we | |
420 | - can print out array elements correctly. Up till now we | |
421 | - know an offset to apply to get the item but we also | |
422 | - have to know how much to add to get to the next item. */ | |
423 | - | |
424 | - ndimen--; | |
425 | - eltlen = TYPE_LENGTH (tmp_type); | |
426 | - F77_DIM_OFFSET (ndimen) = eltlen; | |
427 | - while (--ndimen > 0) | |
428 | - { | |
429 | - eltlen *= F77_DIM_SIZE (ndimen + 1); | |
430 | - F77_DIM_OFFSET (ndimen) = eltlen; | |
431 | - } | |
432 | -} | |
433 | - | |
434 | - | |
435 | - | |
436 | /* Actual function which prints out F77 arrays, Valaddr == address in | |
437 | the superior. Address == the address in the inferior. */ | |
438 | ||
28b292e9 | 439 | @@ -164,41 +112,62 @@ |
aa964043 KK |
440 | const struct value_print_options *options, |
441 | int *elts) | |
442 | { | |
443 | + struct type *range_type = TYPE_INDEX_TYPE (check_typedef (type)); | |
444 | + CORE_ADDR addr = address + embedded_offset; | |
445 | + LONGEST lowerbound, upperbound; | |
446 | int i; | |
447 | ||
448 | + get_discrete_bounds (range_type, &lowerbound, &upperbound); | |
449 | + | |
450 | if (nss != ndimensions) | |
451 | { | |
452 | - for (i = 0; | |
453 | - (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max); | |
454 | + size_t dim_size; | |
455 | + size_t offs = 0; | |
456 | + LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); | |
457 | + | |
458 | + if (byte_stride) | |
459 | + dim_size = byte_stride; | |
460 | + else | |
461 | + dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); | |
462 | + | |
463 | + for (i = lowerbound; | |
464 | + (i < upperbound + 1 && (*elts) < options->print_max); | |
465 | i++) | |
466 | { | |
467 | + struct value *subarray = value_from_contents_and_address | |
468 | + (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val) | |
469 | + + offs, addr + offs); | |
470 | + | |
471 | fprintf_filtered (stream, "( "); | |
472 | - f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type), | |
473 | - valaddr, | |
474 | - embedded_offset + i * F77_DIM_OFFSET (nss), | |
475 | - address, | |
476 | - stream, recurse, val, options, elts); | |
477 | + f77_print_array_1 (nss + 1, ndimensions, value_type (subarray), | |
478 | + value_contents_for_printing (subarray), | |
479 | + value_embedded_offset (subarray), | |
480 | + value_address (subarray), | |
481 | + stream, recurse, subarray, options, elts); | |
482 | + offs += dim_size; | |
483 | fprintf_filtered (stream, ") "); | |
484 | } | |
485 | - if (*elts >= options->print_max && i < F77_DIM_SIZE (nss)) | |
486 | + if (*elts >= options->print_max && i < upperbound) | |
487 | fprintf_filtered (stream, "..."); | |
488 | } | |
489 | else | |
490 | { | |
491 | - for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max; | |
492 | + for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max; | |
493 | i++, (*elts)++) | |
494 | { | |
495 | - val_print (TYPE_TARGET_TYPE (type), | |
496 | - valaddr, | |
497 | - embedded_offset + i * F77_DIM_OFFSET (ndimensions), | |
498 | - address, stream, recurse, | |
499 | - val, options, current_language); | |
500 | + struct value *elt = value_subscript ((struct value *)val, i); | |
501 | + | |
502 | + val_print (value_type (elt), | |
503 | + value_contents_for_printing (elt), | |
504 | + value_embedded_offset (elt), | |
505 | + value_address (elt), stream, recurse, | |
506 | + elt, options, current_language); | |
507 | ||
508 | - if (i != (F77_DIM_SIZE (nss) - 1)) | |
509 | + if (i != upperbound) | |
510 | fprintf_filtered (stream, ", "); | |
511 | ||
512 | if ((*elts == options->print_max - 1) | |
513 | - && (i != (F77_DIM_SIZE (nss) - 1))) | |
514 | + && (i != upperbound)) | |
515 | fprintf_filtered (stream, "..."); | |
516 | } | |
517 | } | |
28b292e9 | 518 | @@ -225,12 +194,6 @@ |
aa964043 KK |
519 | Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"), |
520 | ndimensions, MAX_FORTRAN_DIMS); | |
521 | ||
522 | - /* Since F77 arrays are stored column-major, we set up an | |
523 | - offset table to get at the various row's elements. The | |
524 | - offset table contains entries for both offset and subarray size. */ | |
525 | - | |
526 | - f77_create_arrayprint_offset_tbl (type, stream); | |
527 | - | |
528 | f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset, | |
529 | address, stream, recurse, val, options, &elts); | |
530 | } | |
28b292e9 | 531 | @@ -375,12 +338,15 @@ |
aa964043 KK |
532 | fprintf_filtered (stream, "( "); |
533 | for (index = 0; index < TYPE_NFIELDS (type); index++) | |
534 | { | |
535 | - int offset = TYPE_FIELD_BITPOS (type, index) / 8; | |
536 | + struct value *field = value_field | |
537 | + ((struct value *)original_value, index); | |
538 | + | |
539 | + val_print (value_type (field), | |
540 | + value_contents_for_printing (field), | |
541 | + value_embedded_offset (field), | |
542 | + value_address (field), stream, recurse + 1, | |
543 | + field, options, current_language); | |
544 | ||
545 | - val_print (TYPE_FIELD_TYPE (type, index), valaddr, | |
546 | - embedded_offset + offset, | |
547 | - address, stream, recurse + 1, | |
548 | - original_value, options, current_language); | |
549 | if (index != TYPE_NFIELDS (type) - 1) | |
550 | fputs_filtered (", ", stream); | |
551 | } | |
28b292e9 | 552 | Index: gdb-7.10.50.20160106/gdb/gdbtypes.c |
b1b25d28 | 553 | =================================================================== |
28b292e9 AM |
554 | --- gdb-7.10.50.20160106.orig/gdb/gdbtypes.c 2016-01-08 19:15:35.083582459 +0100 |
555 | +++ gdb-7.10.50.20160106/gdb/gdbtypes.c 2016-01-08 19:15:44.982637674 +0100 | |
556 | @@ -836,7 +836,8 @@ | |
aa964043 KK |
557 | struct type * |
558 | create_range_type (struct type *result_type, struct type *index_type, | |
559 | const struct dynamic_prop *low_bound, | |
560 | - const struct dynamic_prop *high_bound) | |
561 | + const struct dynamic_prop *high_bound, | |
562 | + const struct dynamic_prop *stride) | |
563 | { | |
564 | if (result_type == NULL) | |
565 | result_type = alloc_type_copy (index_type); | |
28b292e9 | 566 | @@ -851,6 +852,7 @@ |
aa964043 KK |
567 | TYPE_ZALLOC (result_type, sizeof (struct range_bounds)); |
568 | TYPE_RANGE_DATA (result_type)->low = *low_bound; | |
569 | TYPE_RANGE_DATA (result_type)->high = *high_bound; | |
570 | + TYPE_RANGE_DATA (result_type)->stride = *stride; | |
571 | ||
572 | if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0) | |
573 | TYPE_UNSIGNED (result_type) = 1; | |
28b292e9 | 574 | @@ -879,7 +881,7 @@ |
aa964043 KK |
575 | create_static_range_type (struct type *result_type, struct type *index_type, |
576 | LONGEST low_bound, LONGEST high_bound) | |
577 | { | |
578 | - struct dynamic_prop low, high; | |
579 | + struct dynamic_prop low, high, stride; | |
580 | ||
581 | low.kind = PROP_CONST; | |
582 | low.data.const_val = low_bound; | |
28b292e9 | 583 | @@ -887,7 +889,11 @@ |
aa964043 KK |
584 | high.kind = PROP_CONST; |
585 | high.data.const_val = high_bound; | |
586 | ||
587 | - result_type = create_range_type (result_type, index_type, &low, &high); | |
588 | + stride.kind = PROP_CONST; | |
589 | + stride.data.const_val = 0; | |
590 | + | |
591 | + result_type = create_range_type (result_type, index_type, | |
592 | + &low, &high, &stride); | |
593 | ||
594 | return result_type; | |
595 | } | |
28b292e9 AM |
596 | @@ -1084,16 +1090,21 @@ |
597 | && (!type_not_associated (result_type) | |
598 | && !type_not_allocated (result_type))) | |
aa964043 KK |
599 | { |
600 | - LONGEST low_bound, high_bound; | |
601 | + LONGEST low_bound, high_bound, byte_stride; | |
602 | ||
603 | if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) | |
604 | low_bound = high_bound = 0; | |
28b292e9 | 605 | element_type = check_typedef (element_type); |
aa964043 KK |
606 | + |
607 | + byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); | |
608 | + | |
609 | /* Be careful when setting the array length. Ada arrays can be | |
610 | empty arrays with the high_bound being smaller than the low_bound. | |
611 | In such cases, the array length should be zero. */ | |
612 | if (high_bound < low_bound) | |
613 | TYPE_LENGTH (result_type) = 0; | |
614 | + else if (byte_stride > 0) | |
615 | + TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1); | |
616 | else if (bit_stride > 0) | |
617 | TYPE_LENGTH (result_type) = | |
618 | (bit_stride * (high_bound - low_bound + 1) + 7) / 8; | |
28b292e9 | 619 | @@ -1804,12 +1815,31 @@ |
aa964043 KK |
620 | static int |
621 | is_dynamic_type_internal (struct type *type, int top_level) | |
622 | { | |
623 | + int index; | |
624 | + | |
625 | + if (!type) | |
626 | + return 0; | |
627 | + | |
628 | type = check_typedef (type); | |
629 | ||
630 | /* We only want to recognize references at the outermost level. */ | |
631 | if (top_level && TYPE_CODE (type) == TYPE_CODE_REF) | |
632 | type = check_typedef (TYPE_TARGET_TYPE (type)); | |
633 | ||
634 | + if (TYPE_ASSOCIATED_PROP (type)) | |
635 | + return 1; | |
636 | + | |
637 | + if (TYPE_ALLOCATED_PROP (type)) | |
638 | + return 1; | |
639 | + | |
640 | + /* Scan field types in the Fortran case for nested dynamic types. | |
641 | + This will be done only for Fortran as in the C++ case an endless recursion | |
642 | + can occur in the area of classes. */ | |
643 | + if (current_language->la_language == language_fortran) | |
644 | + for (index = 0; index < TYPE_NFIELDS (type); index++) | |
645 | + if (is_dynamic_type (TYPE_FIELD_TYPE (type, index))) | |
646 | + return 1; | |
647 | + | |
b1b25d28 JR |
648 | /* Types that have a dynamic TYPE_DATA_LOCATION are considered |
649 | dynamic, even if the type itself is statically defined. | |
650 | From a user's point of view, this may appear counter-intuitive; | |
28b292e9 | 651 | @@ -1844,11 +1874,19 @@ |
aa964043 KK |
652 | { |
653 | gdb_assert (TYPE_NFIELDS (type) == 1); | |
654 | ||
655 | - /* The array is dynamic if either the bounds are dynamic, | |
656 | - or the elements it contains have a dynamic contents. */ | |
657 | + /* The array is dynamic if either | |
658 | + - the bounds are dynamic, | |
659 | + - the elements it contains have a dynamic contents | |
660 | + - a data_locaton attribute was found. */ | |
661 | if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0)) | |
662 | return 1; | |
663 | - return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0); | |
664 | + else if (TYPE_DATA_LOCATION (type) != NULL | |
665 | + && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR | |
666 | + || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) | |
667 | + return 1; | |
668 | + else | |
669 | + return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0); | |
670 | + break; | |
671 | } | |
672 | ||
673 | case TYPE_CODE_STRUCT: | |
28b292e9 | 674 | @@ -1861,6 +1899,18 @@ |
aa964043 KK |
675 | && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0)) |
676 | return 1; | |
677 | } | |
678 | + case TYPE_CODE_PTR: | |
679 | + { | |
680 | + if (TYPE_TARGET_TYPE (type) | |
324d13e1 JR |
681 | + && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING |
682 | + || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)) | |
aa964043 KK |
683 | + return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type))); |
684 | + | |
685 | + return 0; | |
686 | + break; | |
687 | + } | |
688 | + default: | |
689 | + return 0; | |
690 | break; | |
691 | } | |
692 | ||
28b292e9 | 693 | @@ -1890,7 +1940,8 @@ |
324d13e1 | 694 | struct type *static_range_type, *static_target_type; |
aa964043 KK |
695 | const struct dynamic_prop *prop; |
696 | const struct dwarf2_locexpr_baton *baton; | |
697 | - struct dynamic_prop low_bound, high_bound; | |
698 | + struct dynamic_prop low_bound, high_bound, stride; | |
699 | + struct type *range_copy = copy_type (dyn_range_type); | |
700 | ||
701 | gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); | |
702 | ||
28b292e9 | 703 | @@ -1922,12 +1973,19 @@ |
aa964043 KK |
704 | high_bound.data.const_val = 0; |
705 | } | |
324d13e1 | 706 | |
aa964043 | 707 | + prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; |
28b292e9 | 708 | + if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) |
aa964043 KK |
709 | + { |
710 | + stride.kind = PROP_CONST; | |
711 | + stride.data.const_val = value; | |
712 | + } | |
324d13e1 JR |
713 | + |
714 | static_target_type | |
715 | - = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), | |
716 | + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (range_copy), | |
717 | addr_stack, 0); | |
aa964043 | 718 | - static_range_type = create_range_type (copy_type (dyn_range_type), |
aa964043 | 719 | + static_range_type = create_range_type (range_copy, |
324d13e1 JR |
720 | static_target_type, |
721 | - &low_bound, &high_bound); | |
aa964043 KK |
722 | + &low_bound, &high_bound, &stride); |
723 | TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; | |
724 | return static_range_type; | |
725 | } | |
28b292e9 | 726 | @@ -1946,7 +2004,8 @@ |
aa964043 | 727 | struct type *ary_dim; |
28b292e9 | 728 | struct dynamic_prop *prop; |
aa964043 KK |
729 | |
730 | - gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); | |
731 | + gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY | |
b1b25d28 | 732 | + || TYPE_CODE (type) == TYPE_CODE_STRING); |
aa964043 | 733 | |
28b292e9 AM |
734 | type = copy_type (type); |
735 | ||
736 | @@ -1971,13 +2030,18 @@ | |
b1b25d28 | 737 | |
aa964043 KK |
738 | ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); |
739 | ||
740 | - if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) | |
aa964043 | 741 | + if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY |
28b292e9 AM |
742 | + || TYPE_CODE (ary_dim) == TYPE_CODE_STRING)) |
743 | elt_type = resolve_dynamic_array (ary_dim, addr_stack); | |
aa964043 KK |
744 | else |
745 | elt_type = TYPE_TARGET_TYPE (type); | |
746 | ||
28b292e9 AM |
747 | - return create_array_type_with_stride (type, elt_type, range_type, |
748 | - TYPE_FIELD_BITSIZE (type, 0)); | |
324d13e1 JR |
749 | + if (TYPE_CODE (type) == TYPE_CODE_STRING |
750 | + && TYPE_FIELD_BITSIZE (type, 0) == 0) | |
28b292e9 | 751 | + return create_string_type (type, elt_type, range_type); |
aa964043 | 752 | + else |
28b292e9 AM |
753 | + return create_array_type_with_stride (type, elt_type, range_type, |
754 | + TYPE_FIELD_BITSIZE (type, 0)); | |
aa964043 KK |
755 | } |
756 | ||
757 | /* Resolve dynamic bounds of members of the union TYPE to static | |
28b292e9 | 758 | Index: gdb-7.10.50.20160106/gdb/gdbtypes.h |
b1b25d28 | 759 | =================================================================== |
28b292e9 AM |
760 | --- gdb-7.10.50.20160106.orig/gdb/gdbtypes.h 2016-01-08 19:15:35.085582471 +0100 |
761 | +++ gdb-7.10.50.20160106/gdb/gdbtypes.h 2016-01-08 19:15:44.983637680 +0100 | |
762 | @@ -577,6 +577,10 @@ | |
aa964043 | 763 | |
324d13e1 | 764 | struct dynamic_prop high; |
aa964043 | 765 | |
324d13e1 | 766 | + /* * Stride of range. */ |
aa964043 | 767 | + |
324d13e1 | 768 | + struct dynamic_prop stride; |
aa964043 | 769 | + |
324d13e1 JR |
770 | /* True if HIGH range bound contains the number of elements in the |
771 | subrange. This affects how the final hight bound is computed. */ | |
aa964043 | 772 | |
28b292e9 | 773 | @@ -749,6 +753,18 @@ |
aa964043 | 774 | |
324d13e1 JR |
775 | /* * Contains all dynamic type properties. */ |
776 | struct dynamic_prop_list *dyn_prop_list; | |
aa964043 KK |
777 | + |
778 | + /* Structure for DW_AT_allocated. | |
779 | + The presence of this attribute indicates that the object of the type | |
780 | + can be allocated/deallocated. The value can be a dwarf expression, | |
781 | + reference, or a constant. */ | |
782 | + struct dynamic_prop *allocated; | |
783 | + | |
784 | + /* Structure for DW_AT_associated. | |
785 | + The presence of this attribute indicated that the object of the type | |
786 | + can be associated. The value can be a dwarf expression, | |
787 | + reference, or a constant. */ | |
788 | + struct dynamic_prop *associated; | |
789 | }; | |
790 | ||
791 | /* * A ``struct type'' describes a particular instance of a type, with | |
28b292e9 | 792 | @@ -1255,6 +1271,15 @@ |
aa964043 KK |
793 | TYPE_RANGE_DATA(range_type)->high.kind |
794 | #define TYPE_LOW_BOUND_KIND(range_type) \ | |
795 | TYPE_RANGE_DATA(range_type)->low.kind | |
796 | +#define TYPE_BYTE_STRIDE(range_type) \ | |
797 | + TYPE_RANGE_DATA(range_type)->stride.data.const_val | |
798 | +#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ | |
799 | + TYPE_RANGE_DATA(range_type)->stride.data.locexpr | |
800 | +#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ | |
801 | + TYPE_RANGE_DATA(range_type)->stride.data.loclist | |
802 | +#define TYPE_BYTE_STRIDE_KIND(range_type) \ | |
803 | + TYPE_RANGE_DATA(range_type)->stride.kind | |
804 | + | |
324d13e1 JR |
805 | |
806 | /* Property accessors for the type data location. */ | |
807 | #define TYPE_DATA_LOCATION(thistype) \ | |
28b292e9 | 808 | @@ -1266,6 +1291,18 @@ |
324d13e1 JR |
809 | #define TYPE_DATA_LOCATION_KIND(thistype) \ |
810 | TYPE_DATA_LOCATION (thistype)->kind | |
28b292e9 | 811 | |
aa964043 KK |
812 | +/* Allocated status of type object. If set to non-zero it means the object |
813 | + is allocated. A zero value means it is not allocated. */ | |
814 | +#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \ | |
815 | + && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \ | |
816 | + && !TYPE_ALLOCATED_PROP (t)->data.const_val) | |
817 | + | |
818 | +/* Associated status of type object. If set to non-zero it means the object | |
819 | + is associated. A zero value means it is not associated. */ | |
820 | +#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \ | |
821 | + && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \ | |
822 | + && !TYPE_ASSOCIATED_PROP (t)->data.const_val) | |
28b292e9 AM |
823 | + |
824 | /* Property accessors for the type allocated/associated. */ | |
825 | #define TYPE_ALLOCATED_PROP(thistype) \ | |
826 | get_dyn_prop (DYN_PROP_ALLOCATED, thistype) | |
827 | @@ -1289,6 +1326,9 @@ | |
aa964043 KK |
828 | TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) |
829 | #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ | |
830 | TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) | |
831 | +#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ | |
832 | + (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0) | |
833 | + | |
834 | ||
835 | #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ | |
836 | (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) | |
28b292e9 | 837 | @@ -1775,6 +1815,7 @@ |
aa964043 KK |
838 | |
839 | extern struct type *create_range_type (struct type *, struct type *, | |
840 | const struct dynamic_prop *, | |
841 | + const struct dynamic_prop *, | |
842 | const struct dynamic_prop *); | |
843 | ||
844 | extern struct type *create_array_type (struct type *, struct type *, | |
28b292e9 | 845 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp |
b1b25d28 JR |
846 | =================================================================== |
847 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
28b292e9 | 848 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp 2016-01-08 19:15:44.983637680 +0100 |
aa964043 KK |
849 | @@ -0,0 +1,61 @@ |
850 | +# Copyright 2014 Free Software Foundation, Inc. | |
851 | + | |
852 | +# This program is free software; you can redistribute it and/or modify | |
853 | +# it under the terms of the GNU General Public License as published by | |
854 | +# the Free Software Foundation; either version 3 of the License, or | |
855 | +# (at your option) any later version. | |
856 | +# | |
857 | +# This program is distributed in the hope that it will be useful, | |
858 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
859 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
860 | +# GNU General Public License for more details. | |
861 | +# | |
862 | +# You should have received a copy of the GNU General Public License | |
863 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
864 | + | |
865 | +standard_testfile ".f90" | |
866 | + | |
867 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
868 | + {debug f90 quiet}] } { | |
869 | + return -1 | |
870 | +} | |
871 | + | |
872 | +if ![runto MAIN__] then { | |
873 | + perror "couldn't run to breakpoint MAIN__" | |
874 | + continue | |
875 | +} | |
876 | + | |
877 | +# Check VLA passed to first Fortran function. | |
878 | +gdb_breakpoint [gdb_get_line_number "func1-vla-passed"] | |
879 | +gdb_continue_to_breakpoint "func1-vla-passed" | |
880 | +gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \ | |
881 | + "print vla (func1)" | |
882 | +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \ | |
883 | + "ptype vla (func1)" | |
884 | + | |
885 | +gdb_breakpoint [gdb_get_line_number "func1-vla-modified"] | |
886 | +gdb_continue_to_breakpoint "func1-vla-modified" | |
887 | +gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)" | |
888 | +gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)" | |
889 | + | |
890 | +# Check if the values are correct after returning from func1 | |
891 | +gdb_breakpoint [gdb_get_line_number "func1-returned"] | |
892 | +gdb_continue_to_breakpoint "func1-returned" | |
893 | +gdb_test "print ret" " = .TRUE." "print ret after func1 returned" | |
894 | + | |
895 | +# Check VLA passed to second Fortran function | |
896 | +gdb_breakpoint [gdb_get_line_number "func2-vla-passed"] | |
897 | +gdb_continue_to_breakpoint "func2-vla-passed" | |
898 | +gdb_test "print vla" \ | |
899 | + " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \ | |
900 | + "print vla (func2)" | |
901 | +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \ | |
902 | + "ptype vla (func2)" | |
903 | + | |
904 | +# Check if the returned VLA has the correct values and ptype. | |
905 | +gdb_breakpoint [gdb_get_line_number "func2-returned"] | |
906 | +gdb_continue_to_breakpoint "func2-returned" | |
907 | +gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \ | |
908 | + "print vla3 (after func2)" | |
909 | +gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \ | |
910 | + "ptype vla3 (after func2)" | |
28b292e9 | 911 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 |
b1b25d28 JR |
912 | =================================================================== |
913 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
28b292e9 | 914 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 2016-01-08 19:15:44.983637680 +0100 |
aa964043 KK |
915 | @@ -0,0 +1,71 @@ |
916 | +! Copyright 2014 Free Software Foundation, Inc. | |
917 | +! | |
918 | +! This program is free software; you can redistribute it and/or modify | |
919 | +! it under the terms of the GNU General Public License as published by | |
920 | +! the Free Software Foundation; either version 2 of the License, or | |
921 | +! (at your option) any later version. | |
922 | +! | |
923 | +! This program is distributed in the hope that it will be useful, | |
924 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
925 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
926 | +! GNU General Public License for more details. | |
927 | +! | |
928 | +! You should have received a copy of the GNU General Public License | |
929 | +! along with this program; if not, write to the Free Software | |
930 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
931 | + | |
932 | +logical function func1 (vla) | |
933 | + implicit none | |
934 | + integer, allocatable :: vla (:, :) | |
935 | + func1 = allocated(vla) | |
936 | + vla(5,5) = 55 ! func1-vla-passed | |
937 | + vla(7,7) = 77 | |
938 | + return ! func1-vla-modified | |
939 | +end function func1 | |
940 | + | |
941 | +function func2(vla) | |
942 | + implicit none | |
943 | + integer :: vla (:) | |
944 | + integer :: func2(size(vla)) | |
945 | + integer :: k | |
946 | + | |
947 | + vla(1) = 1 ! func2-vla-passed | |
948 | + vla(2) = 2 | |
949 | + vla(4) = 4 | |
950 | + vla(8) = 8 | |
951 | + | |
952 | + func2 = vla | |
953 | +end function func2 | |
954 | + | |
955 | +program vla_func | |
956 | + implicit none | |
957 | + interface | |
958 | + logical function func1 (vla) | |
959 | + integer :: vla (:, :) | |
960 | + end function | |
961 | + end interface | |
962 | + interface | |
963 | + function func2 (vla) | |
964 | + integer :: vla (:) | |
965 | + integer func2(size(vla)) | |
966 | + end function | |
967 | + end interface | |
968 | + | |
969 | + logical :: ret | |
970 | + integer, allocatable :: vla1 (:, :) | |
971 | + integer, allocatable :: vla2 (:) | |
972 | + integer, allocatable :: vla3 (:) | |
973 | + | |
974 | + ret = .FALSE. | |
975 | + | |
976 | + allocate (vla1 (10,10)) | |
977 | + vla1(:,:) = 22 | |
978 | + | |
979 | + allocate (vla2 (10)) | |
980 | + vla2(:) = 44 | |
981 | + | |
982 | + ret = func1(vla1) | |
983 | + vla3 = func2(vla2) ! func1-returned | |
984 | + | |
985 | + ret = .TRUE. ! func2-returned | |
986 | +end program vla_func | |
28b292e9 | 987 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.exp |
b1b25d28 JR |
988 | =================================================================== |
989 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
28b292e9 AM |
990 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.exp 2016-01-08 19:15:44.984637686 +0100 |
991 | @@ -0,0 +1,44 @@ | |
aa964043 KK |
992 | +# Copyright 2014 Free Software Foundation, Inc. |
993 | + | |
994 | +# This program is free software; you can redistribute it and/or modify | |
995 | +# it under the terms of the GNU General Public License as published by | |
996 | +# the Free Software Foundation; either version 3 of the License, or | |
997 | +# (at your option) any later version. | |
998 | +# | |
999 | +# This program is distributed in the hope that it will be useful, | |
1000 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1001 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1002 | +# GNU General Public License for more details. | |
1003 | +# | |
1004 | +# You should have received a copy of the GNU General Public License | |
1005 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
1006 | + | |
28b292e9 | 1007 | +standard_testfile ".f90" |
aa964043 KK |
1008 | + |
1009 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
1010 | + {debug f90 quiet}] } { | |
1011 | + return -1 | |
1012 | +} | |
1013 | + | |
1014 | +if ![runto MAIN__] then { | |
1015 | + perror "couldn't run to breakpoint MAIN__" | |
1016 | + continue | |
1017 | +} | |
1018 | + | |
28b292e9 AM |
1019 | +gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] |
1020 | +gdb_continue_to_breakpoint "re-reverse-elements" | |
1021 | +gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ | |
1022 | + "print re-reverse-elements" | |
1023 | +gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" | |
1024 | +gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" | |
1025 | + | |
1026 | +gdb_breakpoint [gdb_get_line_number "odd-elements"] | |
1027 | +gdb_continue_to_breakpoint "odd-elements" | |
1028 | +gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" | |
1029 | +gdb_test "print pvla(1)" " = 1" "print first odd-element" | |
1030 | +gdb_test "print pvla(5)" " = 9" "print last odd-element" | |
1031 | + | |
1032 | +gdb_breakpoint [gdb_get_line_number "single-element"] | |
1033 | +gdb_continue_to_breakpoint "single-element" | |
1034 | +gdb_test "print pvla" " = \\\(5\\\)" "print single-element" | |
1035 | +gdb_test "print pvla(1)" " = 5" "print one single-element" | |
1036 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.f90 | |
b1b25d28 JR |
1037 | =================================================================== |
1038 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
28b292e9 AM |
1039 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.f90 2016-01-08 19:15:44.984637686 +0100 |
1040 | @@ -0,0 +1,30 @@ | |
1041 | +! Copyright 2014 Free Software Foundation, Inc. | |
1042 | +! | |
1043 | +! This program is free software; you can redistribute it and/or modify | |
1044 | +! it under the terms of the GNU General Public License as published by | |
1045 | +! the Free Software Foundation; either version 2 of the License, or | |
1046 | +! (at your option) any later version. | |
1047 | +! | |
1048 | +! This program is distributed in the hope that it will be useful, | |
1049 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1050 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1051 | +! GNU General Public License for more details. | |
1052 | +! | |
1053 | +! You should have received a copy of the GNU General Public License | |
1054 | +! along with this program; if not, write to the Free Software | |
1055 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
aa964043 | 1056 | + |
28b292e9 AM |
1057 | +program vla_stride |
1058 | + integer, target, allocatable :: vla (:) | |
1059 | + integer, pointer :: pvla (:) | |
aa964043 | 1060 | + |
28b292e9 AM |
1061 | + allocate(vla(10)) |
1062 | + vla = (/ (I, I = 1,10) /) | |
aa964043 | 1063 | + |
28b292e9 AM |
1064 | + pvla => vla(10:1:-1) |
1065 | + pvla => pvla(10:1:-1) | |
1066 | + pvla => vla(1:10:2) ! re-reverse-elements | |
1067 | + pvla => vla(5:4:-2) ! odd-elements | |
aa964043 | 1068 | + |
28b292e9 AM |
1069 | + pvla => null() ! single-element |
1070 | +end program vla_stride | |
1071 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.exp | |
b1b25d28 JR |
1072 | =================================================================== |
1073 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
28b292e9 AM |
1074 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.exp 2016-01-08 19:15:44.984637686 +0100 |
1075 | @@ -0,0 +1,101 @@ | |
aa964043 KK |
1076 | +# Copyright 2014 Free Software Foundation, Inc. |
1077 | + | |
1078 | +# This program is free software; you can redistribute it and/or modify | |
1079 | +# it under the terms of the GNU General Public License as published by | |
1080 | +# the Free Software Foundation; either version 3 of the License, or | |
1081 | +# (at your option) any later version. | |
1082 | +# | |
1083 | +# This program is distributed in the hope that it will be useful, | |
1084 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1085 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1086 | +# GNU General Public License for more details. | |
1087 | +# | |
1088 | +# You should have received a copy of the GNU General Public License | |
1089 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
1090 | + | |
28b292e9 | 1091 | +standard_testfile ".f90" |
aa964043 KK |
1092 | + |
1093 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
1094 | + {debug f90 quiet}] } { | |
1095 | + return -1 | |
1096 | +} | |
1097 | + | |
28b292e9 AM |
1098 | +# check that all fortran standard datatypes will be |
1099 | +# handled correctly when using as VLA's | |
1100 | + | |
aa964043 KK |
1101 | +if ![runto MAIN__] then { |
1102 | + perror "couldn't run to breakpoint MAIN__" | |
1103 | + continue | |
1104 | +} | |
1105 | + | |
28b292e9 AM |
1106 | +gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"] |
1107 | +gdb_continue_to_breakpoint "var_char-allocated-1" | |
1108 | +gdb_test "print var_char" \ | |
1109 | + " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \ | |
1110 | + "print var_char after allocated first time" | |
1111 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \ | |
1112 | + "whatis var_char first time" | |
1113 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \ | |
1114 | + "ptype var_char first time" | |
1115 | +gdb_test "next" "\\d+.*var_char = 'foo'.*" \ | |
1116 | + "next to allocation status of var_char" | |
1117 | +gdb_test "print l" " = .TRUE." "print allocation status first time" | |
aa964043 KK |
1118 | + |
1119 | +gdb_breakpoint [gdb_get_line_number "var_char-filled-1"] | |
1120 | +gdb_continue_to_breakpoint "var_char-filled-1" | |
1121 | +gdb_test "print var_char" \ | |
1122 | + " = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \ | |
1123 | + "print var_char after filled first time" | |
1124 | +gdb_test "print *var_char" " = 'foo'" \ | |
1125 | + "print *var_char after filled first time" | |
1126 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \ | |
1127 | + "whatis var_char after filled first time" | |
1128 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \ | |
1129 | + "ptype var_char after filled first time" | |
1130 | +gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)" | |
1131 | +gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)" | |
1132 | + | |
1133 | +gdb_breakpoint [gdb_get_line_number "var_char-filled-2"] | |
1134 | +gdb_continue_to_breakpoint "var_char-filled-2" | |
1135 | +gdb_test "print var_char" \ | |
1136 | + " = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \ | |
1137 | + "print var_char after allocated second time" | |
1138 | +gdb_test "print *var_char" " = 'foobar'" \ | |
1139 | + "print *var_char after allocated second time" | |
1140 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \ | |
1141 | + "whatis var_char second time" | |
1142 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \ | |
1143 | + "ptype var_char second time" | |
1144 | + | |
1145 | +gdb_breakpoint [gdb_get_line_number "var_char-empty"] | |
1146 | +gdb_continue_to_breakpoint "var_char-empty" | |
1147 | +gdb_test "print var_char" \ | |
1148 | + " = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \ | |
1149 | + "print var_char after set empty" | |
1150 | +gdb_test "print *var_char" " = \"\"" "print *var_char after set empty" | |
1151 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \ | |
1152 | + "whatis var_char after set empty" | |
1153 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \ | |
1154 | + "ptype var_char after set empty" | |
1155 | + | |
1156 | +gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"] | |
1157 | +gdb_continue_to_breakpoint "var_char-allocated-3" | |
1158 | +gdb_test "print var_char" \ | |
1159 | + " = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \ | |
1160 | + "print var_char after allocated third time" | |
1161 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \ | |
1162 | + "whatis var_char after allocated third time" | |
1163 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \ | |
1164 | + "ptype var_char after allocated third time" | |
1165 | + | |
1166 | +gdb_breakpoint [gdb_get_line_number "var_char_p-associated"] | |
1167 | +gdb_continue_to_breakpoint "var_char_p-associated" | |
1168 | +gdb_test "print var_char_p" \ | |
1169 | + " = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \ | |
1170 | + "print var_char_p after associated" | |
1171 | +gdb_test "print *var_char_p" " = 'johndoe'" \ | |
1172 | + "print *var_char_ after associated" | |
1173 | +gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \ | |
1174 | + "whatis var_char_p after associated" | |
1175 | +gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \ | |
1176 | + "ptype var_char_p after associated" | |
28b292e9 | 1177 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.f90 |
b1b25d28 JR |
1178 | =================================================================== |
1179 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
28b292e9 | 1180 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.f90 2016-01-08 19:15:44.984637686 +0100 |
aa964043 KK |
1181 | @@ -0,0 +1,40 @@ |
1182 | +! Copyright 2014 Free Software Foundation, Inc. | |
1183 | +! | |
1184 | +! This program is free software; you can redistribute it and/or modify | |
1185 | +! it under the terms of the GNU General Public License as published by | |
1186 | +! the Free Software Foundation; either version 2 of the License, or | |
1187 | +! (at your option) any later version. | |
1188 | +! | |
1189 | +! This program is distributed in the hope that it will be useful, | |
1190 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1191 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1192 | +! GNU General Public License for more details. | |
1193 | +! | |
1194 | +! You should have received a copy of the GNU General Public License | |
1195 | +! along with this program; if not, write to the Free Software | |
1196 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
1197 | + | |
1198 | +program vla_strings | |
1199 | + character(len=:), target, allocatable :: var_char | |
1200 | + character(len=:), pointer :: var_char_p | |
1201 | + logical :: l | |
1202 | + | |
1203 | + allocate(character(len=10) :: var_char) | |
1204 | + l = allocated(var_char) ! var_char-allocated-1 | |
1205 | + var_char = 'foo' | |
1206 | + deallocate(var_char) ! var_char-filled-1 | |
1207 | + l = allocated(var_char) ! var_char-deallocated | |
1208 | + allocate(character(len=42) :: var_char) | |
1209 | + l = allocated(var_char) | |
1210 | + var_char = 'foobar' | |
1211 | + var_char = '' ! var_char-filled-2 | |
1212 | + var_char = 'bar' ! var_char-empty | |
1213 | + deallocate(var_char) | |
1214 | + allocate(character(len=21) :: var_char) | |
1215 | + l = allocated(var_char) ! var_char-allocated-3 | |
1216 | + var_char = 'johndoe' | |
1217 | + var_char_p => var_char | |
1218 | + l = associated(var_char_p) ! var_char_p-associated | |
1219 | + var_char_p => null() | |
1220 | + l = associated(var_char_p) ! var_char_p-not-associated | |
1221 | +end program vla_strings | |
28b292e9 | 1222 | Index: gdb-7.10.50.20160106/gdb/typeprint.c |
b1b25d28 | 1223 | =================================================================== |
28b292e9 AM |
1224 | --- gdb-7.10.50.20160106.orig/gdb/typeprint.c 2016-01-08 19:15:35.086582476 +0100 |
1225 | +++ gdb-7.10.50.20160106/gdb/typeprint.c 2016-01-08 19:15:44.984637686 +0100 | |
1226 | @@ -460,6 +460,13 @@ | |
aa964043 KK |
1227 | |
1228 | type = value_type (val); | |
1229 | ||
1230 | + if (TYPE_CODE (type) == TYPE_CODE_PTR) | |
1231 | + if (is_dynamic_type (TYPE_TARGET_TYPE (type))) | |
1232 | + { | |
1233 | + val = value_addr (value_ind (val)); | |
1234 | + type = value_type (val); | |
1235 | + } | |
1236 | + | |
1237 | get_user_print_options (&opts); | |
1238 | if (opts.objectprint) | |
1239 | { | |
28b292e9 | 1240 | Index: gdb-7.10.50.20160106/gdb/valarith.c |
b1b25d28 | 1241 | =================================================================== |
28b292e9 AM |
1242 | --- gdb-7.10.50.20160106.orig/gdb/valarith.c 2016-01-08 19:15:35.087582482 +0100 |
1243 | +++ gdb-7.10.50.20160106/gdb/valarith.c 2016-01-08 19:15:44.985637691 +0100 | |
1244 | @@ -193,9 +193,21 @@ | |
aa964043 KK |
1245 | struct type *array_type = check_typedef (value_type (array)); |
1246 | struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); | |
28b292e9 | 1247 | unsigned int elt_size = type_length_units (elt_type); |
aa964043 KK |
1248 | - unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound); |
1249 | + unsigned int elt_offs = longest_to_int (index - lowerbound); | |
1250 | + LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); | |
1251 | struct value *v; | |
1252 | ||
1253 | + if (elt_stride > 0) | |
1254 | + elt_offs *= elt_stride; | |
1255 | + else if (elt_stride < 0) | |
1256 | + { | |
1257 | + int offs = (elt_offs + 1) * elt_stride; | |
1258 | + | |
1259 | + elt_offs = TYPE_LENGTH (array_type) + offs; | |
1260 | + } | |
1261 | + else | |
1262 | + elt_offs *= elt_size; | |
1263 | + | |
1264 | if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) | |
28b292e9 AM |
1265 | && elt_offs >= type_length_units (array_type))) |
1266 | { | |
1267 | Index: gdb-7.10.50.20160106/gdb/valprint.c | |
b1b25d28 | 1268 | =================================================================== |
28b292e9 AM |
1269 | --- gdb-7.10.50.20160106.orig/gdb/valprint.c 2016-01-08 19:15:35.088582487 +0100 |
1270 | +++ gdb-7.10.50.20160106/gdb/valprint.c 2016-01-08 19:15:44.986637697 +0100 | |
1271 | @@ -316,6 +316,18 @@ | |
1272 | return 0; | |
1273 | } | |
aa964043 KK |
1274 | |
1275 | + if (TYPE_NOT_ASSOCIATED (type)) | |
1276 | + { | |
1277 | + val_print_not_associated (stream); | |
1278 | + return 0; | |
1279 | + } | |
1280 | + | |
1281 | + if (TYPE_NOT_ALLOCATED (type)) | |
1282 | + { | |
1283 | + val_print_not_allocated (stream); | |
1284 | + return 0; | |
1285 | + } | |
1286 | + | |
1287 | if (TYPE_CODE (type) != TYPE_CODE_UNION | |
1288 | && TYPE_CODE (type) != TYPE_CODE_STRUCT | |
1289 | && TYPE_CODE (type) != TYPE_CODE_ARRAY) | |
28b292e9 | 1290 | @@ -1025,12 +1037,16 @@ |
aa964043 KK |
1291 | value_check_printable (struct value *val, struct ui_file *stream, |
1292 | const struct value_print_options *options) | |
1293 | { | |
1294 | + const struct type *type; | |
1295 | + | |
1296 | if (val == 0) | |
1297 | { | |
1298 | fprintf_filtered (stream, _("<address of value unknown>")); | |
1299 | return 0; | |
1300 | } | |
1301 | ||
1302 | + type = value_type (val); | |
1303 | + | |
1304 | if (value_entirely_optimized_out (val)) | |
1305 | { | |
1306 | if (options->summary && !val_print_scalar_type_p (value_type (val))) | |
28b292e9 AM |
1307 | @@ -1066,6 +1082,18 @@ |
1308 | { | |
1309 | val_print_not_allocated (stream); | |
aa964043 | 1310 | return 0; |
28b292e9 AM |
1311 | + } |
1312 | + | |
aa964043 KK |
1313 | + if (TYPE_NOT_ASSOCIATED (type)) |
1314 | + { | |
1315 | + val_print_not_associated (stream); | |
1316 | + return 0; | |
1317 | + } | |
1318 | + | |
1319 | + if (TYPE_NOT_ALLOCATED (type)) | |
1320 | + { | |
1321 | + val_print_not_allocated (stream); | |
1322 | + return 0; | |
28b292e9 | 1323 | } |
aa964043 | 1324 | |
28b292e9 AM |
1325 | return 1; |
1326 | Index: gdb-7.10.50.20160106/gdb/valprint.h | |
b1b25d28 | 1327 | =================================================================== |
28b292e9 AM |
1328 | --- gdb-7.10.50.20160106.orig/gdb/valprint.h 2016-01-08 19:15:35.088582487 +0100 |
1329 | +++ gdb-7.10.50.20160106/gdb/valprint.h 2016-01-08 19:15:44.986637697 +0100 | |
1330 | @@ -232,4 +232,8 @@ | |
324d13e1 JR |
1331 | struct format_data *fmtp); |
1332 | extern void print_value (struct value *val, const struct format_data *fmtp); | |
aa964043 KK |
1333 | |
1334 | +extern void val_print_not_allocated (struct ui_file *stream); | |
1335 | + | |
1336 | +extern void val_print_not_associated (struct ui_file *stream); | |
1337 | + | |
1338 | #endif | |
28b292e9 | 1339 | Index: gdb-7.10.50.20160106/gdb/value.c |
b1b25d28 | 1340 | =================================================================== |
28b292e9 AM |
1341 | --- gdb-7.10.50.20160106.orig/gdb/value.c 2016-01-08 19:15:35.090582499 +0100 |
1342 | +++ gdb-7.10.50.20160106/gdb/value.c 2016-01-08 19:15:44.987637702 +0100 | |
b1b25d28 | 1343 | @@ -40,6 +40,7 @@ |
aa964043 KK |
1344 | #include "tracepoint.h" |
1345 | #include "cp-abi.h" | |
1346 | #include "user-regs.h" | |
1347 | +#include "dwarf2loc.h" | |
1348 | ||
1349 | /* Prototypes for exported functions. */ | |
1350 | ||
28b292e9 | 1351 | @@ -1788,6 +1789,25 @@ |
aa964043 KK |
1352 | if (funcs->copy_closure) |
1353 | component->location.computed.closure = funcs->copy_closure (whole); | |
1354 | } | |
1355 | + | |
1356 | + /* For dynamic types compute the address of the component value location in | |
1357 | + sub range types based on the location of the sub range type, if not being | |
1358 | + an internal GDB variable or parts of it. */ | |
1359 | + if (VALUE_LVAL (component) != lval_internalvar | |
1360 | + && VALUE_LVAL (component) != lval_internalvar_component) | |
1361 | + { | |
1362 | + CORE_ADDR addr; | |
1363 | + struct type *type = value_type (whole); | |
1364 | + | |
1365 | + addr = value_raw_address (component); | |
1366 | + | |
1367 | + if (TYPE_DATA_LOCATION (type) | |
1368 | + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) | |
1369 | + { | |
1370 | + addr = TYPE_DATA_LOCATION_ADDR (type); | |
1371 | + set_value_address (component, addr); | |
1372 | + } | |
1373 | + } | |
1374 | } | |
1375 | ||
1376 | \f | |
28b292e9 | 1377 | @@ -3095,13 +3115,22 @@ |
aa964043 KK |
1378 | v = allocate_value_lazy (type); |
1379 | else | |
1380 | { | |
1381 | - v = allocate_value (type); | |
1382 | - value_contents_copy_raw (v, value_embedded_offset (v), | |
1383 | - arg1, value_embedded_offset (arg1) + offset, | |
28b292e9 | 1384 | - type_length_units (type)); |
aa964043 KK |
1385 | + if (TYPE_DATA_LOCATION (type) |
1386 | + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) | |
1387 | + v = value_at_lazy (type, value_address (arg1) + offset); | |
1388 | + else | |
1389 | + { | |
1390 | + v = allocate_value (type); | |
1391 | + value_contents_copy_raw (v, value_embedded_offset (v), | |
1392 | + arg1, value_embedded_offset (arg1) + offset, | |
28b292e9 | 1393 | + type_length_units (type)); |
aa964043 KK |
1394 | + } |
1395 | } | |
1396 | - v->offset = (value_offset (arg1) + offset | |
1397 | - + value_embedded_offset (arg1)); | |
1398 | + | |
1399 | + if (!TYPE_DATA_LOCATION (type) | |
1400 | + || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) | |
1401 | + v->offset = (value_offset (arg1) + offset | |
1402 | + + value_embedded_offset (arg1)); | |
1403 | } | |
1404 | set_value_component_location (v, arg1); | |
1405 | VALUE_REGNUM (v) = VALUE_REGNUM (arg1); | |
28b292e9 | 1406 | @@ -3689,7 +3718,8 @@ |
aa964043 KK |
1407 | struct value *original_value) |
1408 | { | |
1409 | /* Re-adjust type. */ | |
1410 | - deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type)); | |
1411 | + if (!is_dynamic_type (TYPE_TARGET_TYPE (original_type))) | |
1412 | + deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type)); | |
1413 | ||
1414 | /* Add embedding info. */ | |
1415 | set_value_enclosing_type (value, enc_type); | |
28b292e9 | 1416 | @@ -3706,6 +3736,12 @@ |
aa964043 KK |
1417 | struct value *retval; |
1418 | struct type *enc_type; | |
1419 | ||
1420 | + if (current_language->la_language != language_fortran | |
1421 | + && TYPE_DATA_LOCATION (value_type_arg_tmp) != NULL | |
1422 | + && TYPE_DATA_LOCATION_KIND (value_type_arg_tmp) == PROP_CONST) | |
1423 | + arg = value_at_lazy (value_type_arg_tmp, | |
1424 | + TYPE_DATA_LOCATION_ADDR (value_type_arg_tmp)); | |
1425 | + | |
1426 | retval = coerce_ref_if_computed (arg); | |
1427 | if (retval) | |
1428 | return retval; | |
28b292e9 | 1429 | @@ -3834,8 +3870,14 @@ |
aa964043 KK |
1430 | } |
1431 | else if (VALUE_LVAL (val) == lval_memory) | |
1432 | { | |
1433 | - CORE_ADDR addr = value_address (val); | |
1434 | struct type *type = check_typedef (value_enclosing_type (val)); | |
1435 | + CORE_ADDR addr; | |
1436 | + | |
1437 | + if (TYPE_DATA_LOCATION (type) != NULL | |
1438 | + && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) | |
1439 | + addr = TYPE_DATA_LOCATION_ADDR (type); | |
1440 | + else | |
1441 | + addr = value_address (val); | |
1442 | ||
1443 | if (TYPE_LENGTH (type)) | |
1444 | read_value_memory (val, 0, value_stack (val), | |
28b292e9 | 1445 | Index: gdb-7.10.50.20160106/gdb/dwarf2loc.c |
b1b25d28 | 1446 | =================================================================== |
28b292e9 AM |
1447 | --- gdb-7.10.50.20160106.orig/gdb/dwarf2loc.c 2016-01-08 19:15:35.091582504 +0100 |
1448 | +++ gdb-7.10.50.20160106/gdb/dwarf2loc.c 2016-01-08 19:15:44.988637708 +0100 | |
1449 | @@ -2368,6 +2368,11 @@ | |
1450 | address = value_as_address (value_from_pointer (ptr_type, address)); | |
b1b25d28 JR |
1451 | |
1452 | do_cleanups (value_chain); | |
1453 | + | |
1454 | + /* Select right frame to correctly evaluate VLA's during a backtrace. */ | |
1455 | + if (is_dynamic_type (type)) | |
1456 | + select_frame (frame); | |
1457 | + | |
1458 | retval = value_at_lazy (type, address + byte_offset); | |
1459 | if (in_stack_memory) | |
1460 | set_value_stack (retval, 1); | |
28b292e9 | 1461 | @@ -2660,6 +2665,19 @@ |
b1b25d28 JR |
1462 | data, data + size, per_cu); |
1463 | } | |
1464 | ||
1465 | +/* See dwarf2loc.h. */ | |
1466 | + | |
1467 | +int | |
1468 | +dwarf2_address_data_valid (const struct type *type) | |
1469 | +{ | |
1470 | + if (TYPE_NOT_ASSOCIATED (type)) | |
1471 | + return 0; | |
1472 | + | |
1473 | + if (TYPE_NOT_ALLOCATED (type)) | |
1474 | + return 0; | |
1475 | + | |
1476 | + return 1; | |
1477 | +} | |
1478 | \f | |
1479 | /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */ | |
1480 |