aboutsummaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
Diffstat (limited to 'gdb')
-rw-r--r--gdb/ChangeLog16
-rw-r--r--gdb/f-exp.h16
-rw-r--r--gdb/f-exp.y9
-rw-r--r--gdb/f-lang.c40
-rw-r--r--gdb/testsuite/ChangeLog5
-rw-r--r--gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp158
-rw-r--r--gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f9093
7 files changed, 333 insertions, 4 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 072fa09..42d4bf5 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,21 @@
2021-04-07 Andrew Burgess <andrew.burgess@embecosm.com>
+ * f-exp.h (class fortran_structop_operation): New class.
+ * f-exp.y (exp): Create fortran_structop_operation instead of the
+ generic structop_operation.
+ * f-lang.c (fortran_undetermined::evaluate): Re-evaluate
+ expression as EVAL_NORMAL if the result type was dynamic so we can
+ extract the actual array bounds.
+ (fortran_structop_operation::evaluate): New function.
+
+2021-04-07 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * eval.c (evaluate_subexp_standard): Remove
+ EVAL_AVOID_SIDE_EFFECTS handling from STRUCTOP_STRUCT and
+ STRUCTOP_PTR.
+
+2021-04-07 Andrew Burgess <andrew.burgess@embecosm.com>
+
* valops.c (value_cast): Call value_deeply_equal before performing
any cast.
diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index b3d0e0e..955d187 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -273,6 +273,22 @@ public:
{ return std::get<0> (m_storage); }
};
+/* Implement STRUCTOP_STRUCT for Fortran. */
+class fortran_structop_operation
+ : public structop_base_operation
+{
+public:
+
+ using structop_base_operation::structop_base_operation;
+
+ value *evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside) override;
+
+ enum exp_opcode opcode () const override
+ { return STRUCTOP_STRUCT; }
+};
+
} /* namespace expr */
#endif /* FORTRAN_EXP_H */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index ce11b09..6608831 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -492,7 +492,7 @@ exp : '(' type ')' exp %prec UNARY
exp : exp '%' name
{
- pstate->push_new<structop_operation>
+ pstate->push_new<fortran_structop_operation>
(pstate->pop (), copy_name ($3));
}
;
@@ -500,8 +500,8 @@ exp : exp '%' name
exp : exp '%' name COMPLETE
{
structop_base_operation *op
- = new structop_operation (pstate->pop (),
- copy_name ($3));
+ = new fortran_structop_operation (pstate->pop (),
+ copy_name ($3));
pstate->mark_struct_expression (op);
pstate->push (operation_up (op));
}
@@ -510,7 +510,8 @@ exp : exp '%' name COMPLETE
exp : exp '%' COMPLETE
{
structop_base_operation *op
- = new structop_operation (pstate->pop (), "");
+ = new fortran_structop_operation (pstate->pop (),
+ "");
pstate->mark_struct_expression (op);
pstate->push (operation_up (op));
}
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 0c49420..7e921b9 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -1405,6 +1405,9 @@ fortran_undetermined::evaluate (struct type *expect_type,
enum noside noside)
{
value *callee = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+ if (noside == EVAL_AVOID_SIDE_EFFECTS
+ && is_dynamic_type (value_type (callee)))
+ callee = std::get<0> (m_storage)->evaluate (nullptr, exp, EVAL_NORMAL);
struct type *type = check_typedef (value_type (callee));
enum type_code code = type->code ();
@@ -1490,6 +1493,43 @@ fortran_bound_2arg::evaluate (struct type *expect_type,
return fortran_bounds_for_dimension (lbound_p, exp->gdbarch, arg1, arg2);
}
+/* Implement STRUCTOP_STRUCT for Fortran. See operation::evaluate in
+ expression.h for argument descriptions. */
+
+value *
+fortran_structop_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+ const char *str = std::get<1> (m_storage).c_str ();
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *type = lookup_struct_elt_type (value_type (arg1), str, 1);
+
+ if (type != nullptr && is_dynamic_type (type))
+ arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, EVAL_NORMAL);
+ }
+
+ value *elt = value_struct_elt (&arg1, NULL, str, NULL, "structure");
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *elt_type = value_type (elt);
+ if (is_dynamic_type (elt_type))
+ {
+ const gdb_byte *valaddr = value_contents_for_printing (elt);
+ CORE_ADDR address = value_address (elt);
+ gdb::array_view<const gdb_byte> view
+ = gdb::make_array_view (valaddr, TYPE_LENGTH (elt_type));
+ elt_type = resolve_dynamic_type (elt_type, view, address);
+ }
+ elt = value_zero (elt_type, VALUE_LVAL (elt));
+ }
+
+ return elt;
+}
+
} /* namespace expr */
/* See language.h. */
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 0a081fc..1980315 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,10 @@
2021-04-07 Andrew Burgess <andrew.burgess@embecosm.com>
+ * gdb.fortran/dynamic-ptype-whatis.exp: New file.
+ * gdb.fortran/dynamic-ptype-whatis.f90: New file.
+
+2021-04-07 Andrew Burgess <andrew.burgess@embecosm.com>
+
* gdb.cp/rvalue-ref-params.cc (f3): New function.
(f4): New function.
(global_int): New global variable.
diff --git a/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
new file mode 100644
index 0000000..d2ffd6d
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
@@ -0,0 +1,158 @@
+# Copyright 2021 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/> .
+
+# Test using whatis and ptype on different configurations of dynamic
+# types.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if {![fortran_runto_main]} {
+ perror "Could not run to main."
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "Break Here"
+
+gdb_test "whatis var1" "type = real\\(kind=4\\) \\(3\\)"
+gdb_test "whatis var2" "type = real\\(kind=4\\), allocatable \\(4\\)"
+gdb_test "whatis var3" "type = Type type1"
+gdb_test "whatis var4" "type = Type type2"
+gdb_test "whatis var5" "type = Type type3"
+gdb_test "whatis var6" "type = Type type4"
+gdb_test "whatis var7" "type = Type type5"
+gdb_test "ptype var1" "type = real\\(kind=4\\) \\(3\\)"
+gdb_test "ptype var2" "type = real\\(kind=4\\), allocatable \\(4\\)"
+gdb_test "ptype var3" \
+ [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1" ]
+gdb_test "ptype var4" \
+ [multi_line "type = Type type2" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type1, allocatable :: t2_array\\(3\\)" \
+ "End Type type2"]
+gdb_test "ptype var5" \
+ [ multi_line "type = Type type3" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type1 :: t3_array\\(3\\)"\
+ "End Type type3" ]
+gdb_test "ptype var6" \
+ [ multi_line "type = Type type4" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type2, allocatable :: t4_array\\(3\\)" \
+ "End Type type4" ]
+gdb_test "ptype var7" \
+ [ multi_line "type = Type type5" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type2 :: t5_array\\(4\\)" \
+ "End Type type5" ]
+gdb_test "whatis var3%t1_i" "type = integer\\(kind=4\\)"
+gdb_test "whatis var4%t2_array" "type = Type type1, allocatable \\(3\\)"
+gdb_test "whatis var5%t3_array" "type = Type type1 \\(3\\)"
+gdb_test "whatis var6%t4_array" "type = Type type2, allocatable \\(3\\)"
+gdb_test "whatis var7%t5_array" "type = Type type2 \\(4\\)"
+gdb_test "ptype var3%t1_i" [ multi_line "type = integer\\(kind=4\\)" ]
+gdb_test "ptype var4%t2_array" [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1, allocatable \\(3\\)" ]
+gdb_test "ptype var5%t3_array" [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1 \\(3\\)" ]
+gdb_test "ptype var6%t4_array" \
+ [ multi_line "type = Type type2" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type1, allocatable :: t2_array\\(:\\)" \
+ "End Type type2, allocatable \\(3\\)" ]
+gdb_test "ptype var7%t5_array" \
+ [ multi_line "type = Type type2" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type1, allocatable :: t2_array\\(:\\)" \
+ "End Type type2 \\(4\\)" ]
+gdb_test "whatis var4%t2_array(1)" "type = Type type1"
+gdb_test "whatis var5%t3_array(1)" "type = Type type1"
+gdb_test "whatis var6%t4_array(1)" "type = Type type2"
+gdb_test "whatis var7%t5_array(1)" "type = Type type2"
+gdb_test "ptype var4%t2_array(1)" \
+ [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1" ]
+gdb_test "ptype var5%t3_array(1)" \
+ [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1" ]
+gdb_test "ptype var6%t4_array(1)" \
+ [ multi_line "type = Type type2" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type1, allocatable :: t2_array\\(2\\)" \
+ "End Type type2" ]
+gdb_test "ptype var7%t5_array(1)" \
+ [ multi_line "type = Type type2" \
+ " integer\\(kind=4\\) :: spacer" \
+ " Type type1, allocatable :: t2_array\\(2\\)" \
+ "End Type type2" ]
+gdb_test "whatis var4%t2_array(1)%t1_i" "type = integer\\(kind=4\\)"
+gdb_test "whatis var5%t3_array(1)%t1_i" "type = integer\\(kind=4\\)"
+gdb_test "whatis var6%t4_array(1)%t2_array" \
+ "type = Type type1, allocatable \\(2\\)"
+gdb_test "whatis var7%t5_array(1)%t2_array" \
+ "type = Type type1, allocatable \\(2\\)"
+gdb_test "ptype var4%t2_array(1)%t1_i" "type = integer\\(kind=4\\)"
+gdb_test "ptype var5%t3_array(1)%t1_i" "type = integer\\(kind=4\\)"
+gdb_test "ptype var6%t4_array(1)%t2_array" \
+ [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1, allocatable \\(2\\)" ]
+gdb_test "ptype var7%t5_array(1)%t2_array" \
+ [ multi_line "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1, allocatable \\(2\\)" ]
+gdb_test "whatis var6%t4_array(1)%t2_array(1)" \
+ "type = Type type1"
+gdb_test "whatis var7%t5_array(1)%t2_array(1)" \
+ "type = Type type1"
+gdb_test "ptype var6%t4_array(1)%t2_array(1)" \
+ [ multi_line \
+ "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1" ]
+gdb_test "ptype var7%t5_array(1)%t2_array(1)" \
+ [ multi_line \
+ "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1" ]
+gdb_test "ptype var8%ptr_1%t2_array" \
+ [ multi_line \
+ "type = Type type1" \
+ " integer\\(kind=4\\) :: spacer" \
+ " integer\\(kind=4\\) :: t1_i" \
+ "End Type type1, allocatable \\(3\\)" ]
diff --git a/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90 b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90
new file mode 100644
index 0000000..e56bf79
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90
@@ -0,0 +1,93 @@
+! Copyright 2021 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 main
+
+ ! A non-dynamic type.
+ type type1
+ integer(kind=4) :: spacer
+ integer(kind=4) t1_i
+ end type type1
+
+ ! A first dynamic type. The array is of a static type.
+ type type2
+ integer(kind=4) :: spacer
+ type(type1), allocatable :: t2_array(:)
+ end type type2
+
+ ! Another dynamic type, the array is again a static type.
+ type type3
+ integer(kind=4) :: spacer
+ type(type1), pointer :: t3_array(:)
+ end type type3
+
+ ! A dynamic type, this time the array contains a dynamic type.
+ type type4
+ integer(kind=4) :: spacer
+ type(type2), allocatable :: t4_array(:)
+ end type type4
+
+ ! A static type, the array though contains dynamic types.
+ type type5
+ integer(kind=4) :: spacer
+ type(type2) :: t5_array (4)
+ end type type5
+
+ ! A static type containing pointers to a type that contains a
+ ! dynamic array.
+ type type6
+ type(type2), pointer :: ptr_1
+ type(type2), pointer :: ptr_2
+ end type type6
+
+ real, dimension(:), pointer :: var1
+ real, dimension(:), allocatable :: var2
+ type(type1) :: var3
+ type(type2), target :: var4
+ type(type3) :: var5
+ type(type4) :: var6
+ type(type5) :: var7
+ type(type6) :: var8
+
+ allocate (var1 (3))
+
+ allocate (var2 (4))
+
+ allocate (var4%t2_array(3))
+
+ allocate (var5%t3_array(3))
+
+ allocate (var6%t4_array(3))
+ allocate (var6%t4_array(1)%t2_array(2))
+ allocate (var6%t4_array(2)%t2_array(5))
+ allocate (var6%t4_array(3)%t2_array(4))
+
+ allocate (var7%t5_array(1)%t2_array(2))
+ allocate (var7%t5_array(2)%t2_array(5))
+ allocate (var7%t5_array(3)%t2_array(4))
+ allocate (var7%t5_array(4)%t2_array(1))
+
+ var8%ptr_1 => var4
+ var8%ptr_2 => var4
+
+ print *, var1 ! Break Here
+ print *, var2
+ print *, var3
+ print *, var4%t2_array(1)
+ print *, var5%t3_array(2)
+ print *, var6%t4_array(1)%t2_array(1)
+ print *, var7%t5_array(1)%t2_array(1)
+
+end program main
generated by cgit v1.1 at 2024-10-10 19:40:46 +0000