From patchwork Wed Jan 14 13:49:48 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Keven Boell X-Patchwork-Id: 4669 Received: (qmail 26981 invoked by alias); 14 Jan 2015 13:50:10 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 26648 invoked by uid 89); 14 Jan 2015 13:49:57 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.0 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD, UNSUBSCRIBE_BODY autolearn=no version=3.3.2 X-HELO: mga03.intel.com Received: from mga03.intel.com (HELO mga03.intel.com) (134.134.136.65) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 14 Jan 2015 13:49:54 +0000 Received: from fmsmga003.fm.intel.com ([10.253.24.29]) by orsmga103.jf.intel.com with ESMTP; 14 Jan 2015 05:46:10 -0800 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by FMSMGA003.fm.intel.com with ESMTP; 14 Jan 2015 05:36:55 -0800 Received: from ullecvh004g04.iul.intel.com (ullecvh004g04.iul.intel.com [172.28.50.14]) by irvmail001.ir.intel.com (8.14.3/8.13.6/MailSET/Hub) with ESMTP id t0EDnmDs007077; Wed, 14 Jan 2015 13:49:48 GMT Received: from ullecvh004g04.iul.intel.com (ullecvh004g04.iul.intel.com [127.0.0.1]) by ullecvh004g04.iul.intel.com (8.13.8/8.13.8) with ESMTP id t0EDnvuI024111; Wed, 14 Jan 2015 14:49:57 +0100 Received: (from kboell@localhost) by ullecvh004g04.iul.intel.com (8.13.8/8.13.8/Submit) id t0EDnvBJ024110; Wed, 14 Jan 2015 14:49:57 +0100 From: Keven Boell To: gdb-patches@sourceware.org Cc: Keven Boell Subject: [V4 16/18] vla: Fortran dynamic string support Date: Wed, 14 Jan 2015 14:49:48 +0100 Message-Id: <1421243390-24015-17-git-send-email-keven.boell@intel.com> In-Reply-To: <1421243390-24015-1-git-send-email-keven.boell@intel.com> References: <1421243390-24015-1-git-send-email-keven.boell@intel.com> This patch changes the semantic of the Dwarf string length attribute to reflect the standard as well as enables correct string length calculation of dynamic strings. Add tests for varous dynamic string evaluations. Old: (gdb) p my_dyn_string $1 = (PTR TO -> ( character*23959136 )) 0x605fc0 (gdb) p *my_dyn_string Cannot access memory at address 0x605fc0 New: (gdb) p my_dyn_string $1 = (PTR TO -> ( character*10 )) 0x605fc0 (gdb) p *my_dyn_string $2 = 'foo' 2014-05-28 Keven Boell Sanimir Agovic * dwarf2read.c (read_tag_string_type): changed semantic of DW_AT_string_length to be able to handle Dwarf blocks as well. Support for DW_AT_byte_length added to get correct length if specified in combination with DW_AT_string_length. (attr_to_dynamic_prop): added functionality to add Dwarf operators to baton data attribute. Added post values to baton as required by the string evaluation case. (read_subrange_type): Adapt caller. (set_die_type): Adapt caller. (add_post_values_to_baton): New function. * dwarf2loc.c (dwarf2_evaluate_property): Evaluate post processing dwarf. * dwarf2loc.h (struct dwarf2_property_baton): Add post dwarf values attribute. * gdbtypes.c (resolve_dynamic_type): Add conditions to support string types. (resolve_dynamic_array): Add conditions for dynamic strings and create a new string type. (is_dynamic_type): Follow pointer if a string type was detected, as Fortran strings are represented as pointers to strings internally. testsuite/gdb.fortran/: * vla-strings.f90: New file. * vla-strings.exp: New file. Signed-off-by: Keven Boell --- gdb/dwarf2read.c | 144 +++++++++++++++++++++++++---- gdb/gdbtypes.c | 31 +++++-- gdb/testsuite/gdb.fortran/vla-strings.exp | 104 +++++++++++++++++++++ gdb/testsuite/gdb.fortran/vla-strings.f90 | 40 ++++++++ 4 files changed, 295 insertions(+), 24 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.f90 diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index df3ada1..cfb22fe 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -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)); diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 6695adb..967b9e5 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -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); diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp new file mode 100644 index 0000000..1d41e41 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-strings.exp @@ -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 . + +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" diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90 new file mode 100644 index 0000000..98d48d6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-strings.f90 @@ -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