@@ -1844,6 +1844,12 @@ static void free_dwo_file_cleanup (void *);
static void process_cu_includes (void);
static void check_producer (struct dwarf2_cu *cu);
+
+static int
+attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+ struct dwarf2_cu *cu, struct dynamic_prop *prop,
+ const gdb_byte *additional_data, int additional_data_size);
+
/* Various complaints about symbol reading that don't abort the process. */
@@ -14240,29 +14246,92 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
struct gdbarch *gdbarch = get_objfile_arch (objfile);
struct type *type, *range_type, *index_type, *char_type;
struct attribute *attr;
- unsigned int length;
+ unsigned int length = UINT_MAX;
+ index_type = objfile_type (objfile)->builtin_int;
+ range_type = create_static_range_type (NULL, index_type, 1, length);
+
+ /* If DW_AT_string_length is defined, the length is stored at some location
+ * in memory. */
attr = dwarf2_attr (die, DW_AT_string_length, cu);
if (attr)
{
- length = DW_UNSND (attr);
+ if (attr_form_is_block (attr))
+ {
+ struct attribute *byte_size, *bit_size;
+ struct dynamic_prop high;
+
+ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
+ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
+
+ /* DW_AT_byte_size should never occur together in combination with
+ DW_AT_string_length. */
+ if ((byte_size == NULL && bit_size != NULL) ||
+ (byte_size != NULL && bit_size == NULL))
+ complaint (&symfile_complaints, _("DW_AT_byte_size AND "
+ "DW_AT_bit_size found together at the same time."));
+
+ /* If DW_AT_string_length AND DW_AT_byte_size exist together, it
+ describes the number of bytes that should be read from the length
+ memory location. */
+ if (byte_size != NULL && bit_size == NULL)
+ {
+ /* Build new dwarf2_locexpr_baton structure with additions to the
+ data attribute, to reflect DWARF specialities to get address
+ sizes. */
+ const gdb_byte append_ops[] = {
+ /* DW_OP_deref_size: size of an address on the target machine
+ (bytes), where the size will be specified by the next
+ operand. */
+ DW_OP_deref_size,
+ /* Operand for DW_OP_deref_size. */
+ DW_UNSND (byte_size) };
+
+ if (!attr_to_dynamic_prop (attr, die, cu, &high,
+ append_ops, ARRAY_SIZE (append_ops)))
+ complaint (&symfile_complaints,
+ _("Could not parse DW_AT_byte_size"));
+ }
+ else if (bit_size != NULL && byte_size == NULL)
+ complaint (&symfile_complaints, _("DW_AT_string_length AND "
+ "DW_AT_bit_size found but not supported yet."));
+ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
+ is the address size of the target machine. */
+ else
+ {
+ const gdb_byte append_ops[] = { DW_OP_deref };
+
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
+ ARRAY_SIZE (append_ops)))
+ complaint (&symfile_complaints,
+ _("Could not parse DW_AT_string_length"));
+ }
+
+ TYPE_RANGE_DATA (range_type)->high = high;
+ }
+ else
+ {
+ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+ }
}
else
{
- /* Check for the DW_AT_byte_size attribute. */
+ /* Check for the DW_AT_byte_size attribute, which represents the length
+ in this case. */
attr = dwarf2_attr (die, DW_AT_byte_size, cu);
if (attr)
{
- length = DW_UNSND (attr);
+ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
}
else
{
- length = 1;
+ TYPE_HIGH_BOUND (range_type) = 1;
+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
}
}
- index_type = objfile_type (objfile)->builtin_int;
- range_type = create_static_range_type (NULL, index_type, 1, length);
char_type = language_string_char_type (cu->language_defn, gdbarch);
type = create_string_type (NULL, char_type, range_type);
@@ -14579,13 +14648,15 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
return set_die_type (die, type, cu);
}
+
/* Parse dwarf attribute if it's a block, reference or constant and put the
resulting value of the attribute into struct bound_prop.
Returns 1 if ATTR could be resolved into PROP, 0 otherwise. */
static int
attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
- struct dwarf2_cu *cu, struct dynamic_prop *prop)
+ struct dwarf2_cu *cu, struct dynamic_prop *prop,
+ const gdb_byte *additional_data, int additional_data_size)
{
struct dwarf2_property_baton *baton;
struct obstack *obstack = &cu->objfile->objfile_obstack;
@@ -14598,8 +14669,25 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
baton = obstack_alloc (obstack, sizeof (*baton));
baton->referenced_type = NULL;
baton->locexpr.per_cu = cu->per_cu;
- baton->locexpr.size = DW_BLOCK (attr)->size;
- baton->locexpr.data = DW_BLOCK (attr)->data;
+
+ if (additional_data != NULL && additional_data_size > 0)
+ {
+ gdb_byte *data;
+
+ data = obstack_alloc (&cu->objfile->objfile_obstack,
+ DW_BLOCK (attr)->size + additional_data_size);
+ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
+ memcpy (data + DW_BLOCK (attr)->size,
+ additional_data, additional_data_size);
+
+ baton->locexpr.data = data;
+ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
+ }
+ else
+ {
+ baton->locexpr.data = DW_BLOCK (attr)->data;
+ baton->locexpr.size = DW_BLOCK (attr)->size;
+ }
prop->data.baton = baton;
prop->kind = PROP_LOCEXPR;
gdb_assert (prop->data.baton != NULL);
@@ -14629,8 +14717,28 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
baton = obstack_alloc (obstack, sizeof (*baton));
baton->referenced_type = die_type (target_die, target_cu);
baton->locexpr.per_cu = cu->per_cu;
- baton->locexpr.size = DW_BLOCK (target_attr)->size;
- baton->locexpr.data = DW_BLOCK (target_attr)->data;
+
+ if (additional_data != NULL && additional_data_size > 0)
+ {
+ gdb_byte *data;
+
+ data = obstack_alloc (&cu->objfile->objfile_obstack,
+ DW_BLOCK (target_attr)->size + additional_data_size);
+ memcpy (data, DW_BLOCK (target_attr)->data,
+ DW_BLOCK (target_attr)->size);
+ memcpy (data + DW_BLOCK (target_attr)->size,
+ additional_data, additional_data_size);
+
+ baton->locexpr.data = data;
+ baton->locexpr.size = (DW_BLOCK (target_attr)->size
+ + additional_data_size);
+ }
+ else
+ {
+ baton->locexpr.data = DW_BLOCK (target_attr)->data;
+ baton->locexpr.size = DW_BLOCK (target_attr)->size;
+ }
+
prop->data.baton = baton;
prop->kind = PROP_LOCEXPR;
gdb_assert (prop->data.baton != NULL);
@@ -14720,17 +14828,17 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
if (attr)
- attr_to_dynamic_prop (attr, die, cu, &low);
+ attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
else if (!low_default_is_valid)
complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
"- DIE at 0x%x [in module %s]"),
die->offset.sect_off, objfile_name (cu->objfile));
attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
- if (!attr_to_dynamic_prop (attr, die, cu, &high))
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
{
attr = dwarf2_attr (die, DW_AT_count, cu);
- if (attr_to_dynamic_prop (attr, die, cu, &high))
+ if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
{
/* If bounds are constant do the final calculation here. */
if (low.kind == PROP_CONST && high.kind == PROP_CONST)
@@ -21863,7 +21971,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
{
struct dynamic_prop prop;
- if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
{
TYPE_ALLOCATED_PROP (type)
= obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
@@ -21877,7 +21985,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
{
struct dynamic_prop prop;
- if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
{
TYPE_ASSOCIATED_PROP (type)
= obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
@@ -21887,7 +21995,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
/* Read DW_AT_data_location and set in type. */
attr = dwarf2_attr (die, DW_AT_data_location, cu);
- if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
{
TYPE_DATA_LOCATION (type)
= obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
@@ -1693,6 +1693,17 @@ is_dynamic_type_internal (struct type *type, int top_level)
&& is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0))
return 1;
}
+ case TYPE_CODE_PTR:
+ {
+ if (TYPE_TARGET_TYPE (type)
+ && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
+ return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type)));
+
+ return 0;
+ break;
+ }
+ default:
+ return 0;
break;
}
@@ -1775,7 +1786,8 @@ resolve_dynamic_array (struct type *type, CORE_ADDR addr)
struct dynamic_prop *prop;
struct type *copy = copy_type (type);
- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
+ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
+ || TYPE_CODE (type) == TYPE_CODE_STRING);
elt_type = type;
range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
@@ -1797,14 +1809,20 @@ resolve_dynamic_array (struct type *type, CORE_ADDR addr)
ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
+ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
+ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr);
else
elt_type = TYPE_TARGET_TYPE (type);
- return create_array_type (copy,
- elt_type,
- range_type);
+ if (TYPE_CODE (type) == TYPE_CODE_STRING)
+ return create_string_type (copy,
+ elt_type,
+ range_type);
+ else
+ return create_array_type (copy,
+ elt_type,
+ range_type);
}
/* Resolve dynamic bounds of members of the union TYPE to static
@@ -1948,8 +1966,9 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
}
case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
resolved_type = resolve_dynamic_array (type, addr);
- break;
+ break;
case TYPE_CODE_RANGE:
resolved_type = resolve_dynamic_range (type, addr);
new file mode 100644
@@ -0,0 +1,104 @@
+# Copyright 2015 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+# check that all fortran standard datatypes will be
+# handled correctly when using as VLA's
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
+gdb_continue_to_breakpoint "var_char-allocated-1"
+gdb_test "print var_char" \
+ " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
+ "print var_char after allocated first time"
+gdb_test "print *var_char" \
+ " = '\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000'" \
+ "print *var_char after allocated first time"
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \
+ "whatis var_char first time"
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \
+ "ptype var_char first time"
+gdb_test "next" "\\d+.*var_char = 'foo'.*" \
+ "next to allocation status of var_char"
+gdb_test "print l" " = .TRUE." "print allocation status first time"
+
+gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
+gdb_continue_to_breakpoint "var_char-filled-1"
+gdb_test "print var_char" \
+ " = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \
+ "print var_char after filled first time"
+gdb_test "print *var_char" " = 'foo'" \
+ "print *var_char after filled first time"
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \
+ "whatis var_char after filled first time"
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \
+ "ptype var_char after filled first time"
+gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
+gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
+
+gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
+gdb_continue_to_breakpoint "var_char-filled-2"
+gdb_test "print var_char" \
+ " = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \
+ "print var_char after allocated second time"
+gdb_test "print *var_char" " = 'foobar'" \
+ "print *var_char after allocated second time"
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \
+ "whatis var_char second time"
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \
+ "ptype var_char second time"
+
+gdb_breakpoint [gdb_get_line_number "var_char-empty"]
+gdb_continue_to_breakpoint "var_char-empty"
+gdb_test "print var_char" \
+ " = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \
+ "print var_char after set empty"
+gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \
+ "whatis var_char after set empty"
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \
+ "ptype var_char after set empty"
+
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]
+gdb_continue_to_breakpoint "var_char-allocated-3"
+gdb_test "print var_char" \
+ " = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \
+ "print var_char after allocated third time"
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \
+ "whatis var_char after allocated third time"
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \
+ "ptype var_char after allocated third time"
+
+gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]
+gdb_continue_to_breakpoint "var_char_p-associated"
+gdb_test "print var_char_p" \
+ " = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \
+ "print var_char_p after associated"
+gdb_test "print *var_char_p" " = 'johndoe'" \
+ "print *var_char_ after associated"
+gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
+ "whatis var_char_p after associated"
+gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
+ "ptype var_char_p after associated"
new file mode 100644
@@ -0,0 +1,40 @@
+! Copyright 2015 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+program vla_strings
+ character(len=:), target, allocatable :: var_char
+ character(len=:), pointer :: var_char_p
+ logical :: l
+
+ allocate(character(len=10) :: var_char)
+ l = allocated(var_char) ! var_char-allocated-1
+ var_char = 'foo'
+ deallocate(var_char) ! var_char-filled-1
+ l = allocated(var_char) ! var_char-deallocated
+ allocate(character(len=42) :: var_char)
+ l = allocated(var_char)
+ var_char = 'foobar'
+ var_char = '' ! var_char-filled-2
+ var_char = 'bar' ! var_char-empty
+ deallocate(var_char)
+ allocate(character(len=21) :: var_char)
+ l = allocated(var_char) ! var_char-allocated-3
+ var_char = 'johndoe'
+ var_char_p => var_char
+ l = associated(var_char_p) ! var_char_p-associated
+ var_char_p => null()
+ l = associated(var_char_p) ! var_char_p-not-associated
+end program vla_strings