This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH 1/3] Fortran: Handle associated property of pointer types.
- From: Bernhard Heckel <bernhard dot heckel at intel dot com>
- To: qiyaoltc at gmail dot com, eliz at gnu dot org
- Cc: gdb-patches at sourceware dot org, Bernhard Heckel <bernhard dot heckel at intel dot com>
- Date: Mon, 6 Jun 2016 15:37:11 +0200
- Subject: [PATCH 1/3] Fortran: Handle associated property of pointer types.
- Authentication-results: sourceware.org; auth=none
- References: <1465220233-32286-1-git-send-email-bernhard dot heckel at intel dot com>
Some fortran compiler don't create the associated property but
set the pointers content to zero. In order to have a common
way to handle not associated pointers, the missing associated
property is added.
Before:
(gdb) print *intp
Cannot access memory address 0x0
After:
(gdb) print *intp
$1 = <not associated>
2016-05-01 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* gdbtypes.c (is_dynamic_type_internal): Handle fortran pointers.
(resolve_dynamic_type_internal): Add pointer case.
(resolve_dynamic_pointer_type): New.
gdb/Testsuite/Changelog:
* gdb.fortran/pointers.f90: New.
* gdb.fortran/pointers.exp: New.
* gdb.fortran/print_type.exp: New.
---
gdb/gdbtypes.c | 67 ++++++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.exp | 54 +++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 61 +++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/print_type.exp | 62 +++++++++++++++++++++++++++++
gdb/valops.c | 3 ++
5 files changed, 247 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
create mode 100644 gdb/testsuite/gdb.fortran/pointers.f90
create mode 100755 gdb/testsuite/gdb.fortran/print_type.exp
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 9e1759b..ae5b69a 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1828,6 +1828,18 @@ is_dynamic_type_internal (struct type *type, int top_level)
switch (TYPE_CODE (type))
{
+ case TYPE_CODE_PTR:
+ {
+ /* Some Fortran compiler don't create the associated property
+ which would cause a "return 1".
+ For a correct value/type print we have to treat
+ every pointer as dynamic type to cover nullified pointers
+ as well as dynamic target types. */
+ if (current_language->la_language == language_fortran)
+ return 1;
+
+ return 0;
+ }
case TYPE_CODE_RANGE:
{
/* A range type is obviously dynamic if it has at least one
@@ -2105,6 +2117,57 @@ resolve_dynamic_struct (struct type *type,
return resolved_type;
}
+/* Worker for pointer types. */
+
+static struct type *
+resolve_dynamic_pointer (struct type *type,
+ struct property_addr_info *addr_stack)
+{
+ struct property_addr_info pinfo;
+
+ /* If valaddr is set, the type was already resolved
+ and assigned to an value. */
+ if (0 != addr_stack->valaddr)
+ return type;
+
+ if (TYPE_OBJFILE_OWNED (type))
+ {
+ struct dynamic_prop * prop;
+ CORE_ADDR value;
+
+ type = copy_type (type);
+
+ /* Resolve associated property. */
+ prop = TYPE_ASSOCIATED_PROP (type);
+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ {
+ TYPE_DYN_PROP_ADDR (prop) = value;
+ TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
+ }
+ else
+ {
+ /* Compiler doesn't create associated property for this pointer
+ therefore we have to check wheater it is still null. */
+ struct dynamic_prop prop_asso;
+
+ if (0 != read_memory_typed_address (addr_stack->addr, type))
+ prop_asso.data.const_val = 1;
+ else
+ prop_asso.data.const_val = 0;
+
+ prop_asso.kind = PROP_CONST;
+ add_dyn_prop (DYN_PROP_ASSOCIATED, prop_asso, type, TYPE_OBJFILE(type));
+ }
+ }
+ else
+ {
+ /* Do nothing, as this pointer is created on the fly and therefore
+ associated. For example "print *((integer*) &intvla)". */
+ }
+
+ return type;
+}
+
/* Worker for resolved_dynamic_type. */
static struct type *
@@ -2153,6 +2216,10 @@ resolve_dynamic_type_internal (struct type *type,
break;
}
+ case TYPE_CODE_PTR:
+ resolved_type = resolve_dynamic_pointer (type, addr_stack);
+ break;
+
case TYPE_CODE_ARRAY:
resolved_type = resolve_dynamic_array (type, addr_stack);
break;
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
new file mode 100644
index 0000000..0ab08c0
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,54 @@
+# Copyright 2016 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 "pointers.f90"
+load_lib fortran.exp
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# Depending on the compiler being used, the type names can be printed differently.
+set logical [fortran_logical4]
+set real [fortran_real4]
+set int [fortran_int4]
+set complex [fortran_complex4]
+
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "print logp" "= <not associated>" "print logp, not associated"
+gdb_test "print comp" "= <not associated>" "print comp, not associated"
+gdb_test "print charp" "= <not associated>" "print charp, not associated"
+gdb_test "print charap" "= <not associated>" "print charap, not associated"
+gdb_test "print intp" "= <not associated>" "print intp, not associated"
+gdb_test "print intap" "= <not associated>" "print intap, not associated"
+gdb_test "print realp" "= <not associated>" "print realp, not associated"
+gdb_test "print \$my_var = intp" "= <not associated>"
+
+gdb_breakpoint [gdb_get_line_number "After value assignment"]
+gdb_continue_to_breakpoint "After value assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?" "print logp, associated"
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?" "print comp, associated"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?" "print charp, associated"
+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?" "print charap, associated"
+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?" "print intp, associated"
+gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?" "print realp, associated"
+gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
new file mode 100644
index 0000000..fbfaed6
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -0,0 +1,61 @@
+! Copyright 2016 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/>.
+
+program pointers
+
+ logical, target :: logv
+ complex, target :: comv
+ character, target :: charv
+ character (len=3), target :: chara
+ integer, target :: intv
+ integer, target :: inta (10)
+ real, target :: realv
+
+ logical, pointer :: logp
+ complex, pointer :: comp
+ character, pointer:: charp
+ character (len=3), pointer:: charap
+ integer, pointer :: intp
+ integer, pointer :: intap (:)
+ real, pointer :: realp
+
+ nullify (logp)
+ nullify (comp)
+ nullify (charp)
+ nullify (charap)
+ nullify (intp)
+ nullify (intap)
+ nullify (realp)
+
+ logp => logv ! Before pointer assignment
+ comp => comv
+ charp => charv
+ charap => chara
+ intp => intv
+ intap => inta
+ realp => realv
+
+ logv = associated(logp) ! Before value assignment
+ comv = cmplx(1,2)
+ charv = "a"
+ chara = "abc"
+ intv = 10
+ inta(:) = 1
+ inta(3) = 3
+ realv = 3.14
+
+ intv = intv + 1 ! After value assignment
+
+end program pointers
diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp
new file mode 100755
index 0000000..283cb24
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/print_type.exp
@@ -0,0 +1,62 @@
+# Copyright 2016 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 "pointers.f90"
+load_lib fortran.exp
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# Depending on the compiler being used, the type names can be printed differently.
+set logical [fortran_logical4]
+set real [fortran_real4]
+set int [fortran_int4]
+set complex [fortran_complex4]
+
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "ptype logp" "= <not associated>" "ptype logp, not associated"
+gdb_test "ptype comp" "= <not associated>" "ptype comp, not associated"
+gdb_test "ptype charp" "= <not associated>" "ptype charp, not associated"
+gdb_test "ptype charap" "= <not associated>" "ptype charap, not associated"
+gdb_test "ptype intp" "= <not associated>" "ptype intp, not associated"
+gdb_test "ptype intap" "= <not associated>" "ptype intap, not associated"
+gdb_test "ptype realp" "= <not associated>" "ptype realp, not associated"
+
+gdb_breakpoint [gdb_get_line_number "After value assignment"]
+gdb_continue_to_breakpoint "After value assignment"
+gdb_test "ptype logv" "type = $logical"
+gdb_test "ptype comv" "type = $complex"
+gdb_test "ptype charv" "type = character\\*1"
+gdb_test "ptype chara" "type = character\\*3"
+gdb_test "ptype intv" "type = $int"
+gdb_test "ptype inta" "type = $int \\(10\\)"
+gdb_test "ptype realv" "type = $real"
+
+gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)"
+gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)"
+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)"
+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)"
+gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)"
+gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
+
diff --git a/gdb/valops.c b/gdb/valops.c
index 71fb1b3..5ef0c65 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1554,6 +1554,9 @@ value_ind (struct value *arg1)
{
struct type *enc_type;
+ if (type_not_associated (base_type))
+ error (_("Attempt to take contents of a not associated pointer."));
+
/* We may be pointing to something embedded in a larger object.
Get the real type of the enclosing object. */
enc_type = check_typedef (value_enclosing_type (arg1));
--
2.7.1.339.g0233b80