This is the mail archive of the
archer@sourceware.org
mailing list for the Archer project.
[vla] [commit] Fix variable length Fortran strings for -O -g code
- From: Jan Kratochvil <jan dot kratochvil at redhat dot com>
- To: archer at sourceware dot org
- Date: Sat, 29 Aug 2009 00:49:25 +0200
- Subject: [vla] [commit] Fix variable length Fortran strings for -O -g code
commit 8b00dbce48b701da73f8f5092ac2e72c5efbb0e5
Author: Jan Kratochvil <jkratoch@host1.dyn.jankratochvil.net>
Date: Sat Aug 29 00:45:23 2009 +0200
Fix variable length Fortran strings for -O -g code (being IN_REG).
The TYPE_CODE_STRING change may be unrelated, it fixes:
to be printed as:
although maybe a Fortran specific trimming of trailing spaces would be
appropriate.
Original bugreport by Orion Poplawski at:
https://bugzilla.redhat.com/show_bug.cgi?id=508406#c9
gdb/
* dwarf2loc.c (dwarf_locexpr_baton_eval): Support IN_REG results.
* dwarf2read.c
(read_tag_string_type <attr_form_is_block (DW_AT_string_length)>):
Support DW_OP_reg* content. Generate constant-size DWARF block padded
by DW_OP_nop instead of a variable sized one.
* valprint.c (scalar_type_p <TYPE_CODE_STRING>): Return as scalar.
gdb/testsuite/
* gdb.opt/fortran-string.exp, gdb.opt/fortran-string.f90: New.
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index eabecb5..3258484 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -321,11 +321,20 @@ dwarf_locexpr_baton_eval (struct dwarf2_locexpr_baton *dlbaton)
dlbaton->per_cu);
if (ctx->num_pieces > 0)
error (_("DW_OP_*piece is unsupported for DW_FORM_block"));
- else if (ctx->in_reg)
- error (_("Register result is unsupported for DW_FORM_block"));
retval = dwarf_expr_fetch (ctx, 0);
+ if (ctx->in_reg)
+ {
+ /* Inlined dwarf_expr_read_reg as we no longer have the baton. */
+
+ int gdb_regnum = gdbarch_dwarf2_reg_to_regnum (ctx->gdbarch, retval);
+ struct type *type = builtin_type (ctx->gdbarch)->builtin_data_ptr;
+ struct frame_info *frame = get_selected_frame (NULL);
+
+ retval = address_from_register (type, gdb_regnum, frame);
+ }
+
do_cleanups (back_to);
return retval;
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 9f99e39..1e2d588 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -5752,37 +5752,58 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
its value. */
else
{
- struct dwarf2_locexpr_baton *length_baton;
- struct attribute *size_attr;
-
- length_baton = obstack_alloc (&cu->comp_unit_obstack,
- sizeof (*length_baton));
- length_baton->per_cu = cu->per_cu;
- length_baton->data = obstack_alloc (&cu->comp_unit_obstack,
- DW_BLOCK (attr)->size + 2);
- memcpy (length_baton->data, DW_BLOCK (attr)->data,
- DW_BLOCK (attr)->size);
-
- /* DW_AT_BYTE_SIZE existing together with DW_AT_STRING_LENGTH
- specifies the size of an integer to fetch. */
-
- size_attr = dwarf2_attr (die, DW_AT_byte_size, cu);
- if (size_attr)
+ struct dwarf2_locexpr_baton *length_baton = NULL;
+ struct dwarf_block *blk = DW_BLOCK (attr);
+
+ /* Turn any single DW_OP_reg* into DW_OP_breg*(0) but clearing
+ DW_OP_deref* in such case. */
+
+ if (blk->size == 1 && blk->data[0] >= DW_OP_reg0
+ && blk->data[0] <= DW_OP_reg31)
+ length_baton = dwarf2_attr_to_locexpr_baton (attr, cu);
+ else if (blk->size > 1 && blk->data[0] == DW_OP_regx)
{
- length_baton->size = DW_BLOCK (attr)->size + 2;
- length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref_size;
- length_baton->data[DW_BLOCK (attr)->size + 1]
- = DW_UNSND (size_attr);
- if (length_baton->data[DW_BLOCK (attr)->size + 1]
- != DW_UNSND (size_attr))
- complaint (&symfile_complaints,
- _("DW_AT_string_length's DW_AT_byte_size integer "
- "exceeds the byte size storage"));
+ ULONGEST ulongest;
+ gdb_byte *end;
+
+ end = read_uleb128 (&blk->data[1], &blk->data[blk->size],
+ &ulongest);
+ if (end == &blk->data[blk->size])
+ length_baton = dwarf2_attr_to_locexpr_baton (attr, cu);
}
- else
+
+ if (length_baton == NULL)
{
- length_baton->size = DW_BLOCK (attr)->size + 1;
- length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref;
+ struct attribute *size_attr;
+
+ length_baton = obstack_alloc (&cu->comp_unit_obstack,
+ sizeof (*length_baton));
+ length_baton->per_cu = cu->per_cu;
+ length_baton->size = DW_BLOCK (attr)->size + 2;
+ length_baton->data = obstack_alloc (&cu->comp_unit_obstack,
+ length_baton->size);
+ memcpy (length_baton->data, DW_BLOCK (attr)->data,
+ DW_BLOCK (attr)->size);
+
+ /* DW_AT_BYTE_SIZE existing together with DW_AT_STRING_LENGTH
+ specifies the size of an integer to fetch. */
+ size_attr = dwarf2_attr (die, DW_AT_byte_size, cu);
+ if (size_attr)
+ {
+ length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref_size;
+ length_baton->data[DW_BLOCK (attr)->size + 1] =
+ DW_UNSND (size_attr);
+ if (length_baton->data[DW_BLOCK (attr)->size + 1]
+ != DW_UNSND (size_attr))
+ complaint (&symfile_complaints,
+ _("DW_AT_string_length's DW_AT_byte_size "
+ "integer exceeds the byte size storage"));
+ }
+ else
+ {
+ length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref;
+ length_baton->data[DW_BLOCK (attr)->size + 1] = DW_OP_nop;
+ }
}
TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1);
diff --git a/gdb/testsuite/gdb.opt/fortran-string.exp b/gdb/testsuite/gdb.opt/fortran-string.exp
new file mode 100644
index 0000000..f997eec
--- /dev/null
+++ b/gdb/testsuite/gdb.opt/fortran-string.exp
@@ -0,0 +1,41 @@
+# Copyright 2009 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.
+
+# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+# Test GDB can cope with Fortran strings having their length present in a CPU
+# register. With -O0 the string length is passed on the stack. To make this
+# test meaningful the follow assertion should pass. It is not being checked
+# here as the "_s" symbol is compiler dependent:
+# (gdb) info address _s
+# Symbol "_s" is a variable in register XX.
+
+set test fortran-string
+set srcfile ${test}.f90
+if { [prepare_for_testing ${test}.exp ${test} ${srcfile} {debug f77 additional_flags=-O2}] } {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "s = s"]
+gdb_continue_to_breakpoint "s = s"
+gdb_test "frame" ".*s='foo'.*"
+gdb_test "ptype s" "type = character\\*3"
+gdb_test "p s" "\\$\[0-9\]* = 'foo'"
diff --git a/gdb/testsuite/gdb.opt/fortran-string.f90 b/gdb/testsuite/gdb.opt/fortran-string.f90
new file mode 100644
index 0000000..e48d520
--- /dev/null
+++ b/gdb/testsuite/gdb.opt/fortran-string.f90
@@ -0,0 +1,28 @@
+! Copyright 2009 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.
+!
+! Ihis file is the Fortran source file for dynamic.exp.
+! Original file written by Jakub Jelinek <jakub@redhat.com>.
+! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+ subroutine f(s)
+ character*(*) s
+ s = s
+ end
+
+ program main
+ call f ('foo')
+ end
diff --git a/gdb/valprint.c b/gdb/valprint.c
index cbb5d94..e5b12f2 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -236,7 +236,6 @@ scalar_type_p (struct type *type)
case TYPE_CODE_STRUCT:
case TYPE_CODE_UNION:
case TYPE_CODE_SET:
- case TYPE_CODE_STRING:
case TYPE_CODE_BITSTRING:
return 0;
default: