[PATCH] gdb/fortran: handle dynamic types within arrays and structures

[PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Andrew Burgess]

This commit replaces this patch:

  https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html

which was itself a replacement for this patch:

  https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html

The motivation behind the original patch can be seen in the new test,
which currently gives a GDB session like this:

  (gdb) ptype var8
  type = Type type6
      PTR TO -> ( Type type2 :: ptr_1 )
      PTR TO -> ( Type type2 :: ptr_2 )
  End Type type6
  (gdb) ptype var8%ptr_2
  type = PTR TO -> ( Type type2
      integer(kind=4) :: spacer
      Type type1, allocatable :: t2_array(:)	<------ Issue #1
  End Type type2 )
  (gdb) ptype var8%ptr_2%t2_array
  Cannot access memory at address 0x38		<------ Issue #2
  (gdb)

Issue #1: Here we see the abstract dynamic type, rather than the
resolved concrete type.  Though in some cases the user might be
interested in the abstract dynamic type, I think that in most cases
showing the resolved concrete type will be of more use.  Plus, the
user can always figure out the dynamic type (by source code inspection
if nothing else) given the concrete type, but it is much harder to
figure out the concrete type given only the dynamic type.

Issue #2: In this example, GDB evaluates the expression in
EVAL_AVOID_SIDE_EFFECTS mode (due to ptype).  The value returned for
var8%ptr_2 will be a non-lazy, zero value of the correct dynamic
type.  However, when GDB asks about the type of t2_array this requires
GDB to access the value of var8%ptr_2 in order to read the dynamic
properties.  As this value was forced to zero (thanks to the use of
EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base
of zero plus some offset.

Both this patch, and my previous two attempts, have all tried to
resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the
result value with a zero value in some cases.

This new patch is influenced by how Ada handles its tagged typed.
There are plenty of examples in ada-lang.c, but one specific case is
ada_structop_operation::evaluate.  When GDB spots that we are dealing
with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS
mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode.

This commit handles two cases like this specifically for Fortran, a
new fortran_structop_operation, and the already existing
fortran_undetermined, which is where we handle array accesses.

In these two locations we spot when we are dealing with a dynamic type
and re-evaluate the child operation in EVAL_NORMAL mode so that we
are able to access the dynamic properties of the type.

The rest of this commit message is my attempt to record why my
previous patches failed.

To understand my second patch, and why it failed lets consider two
expressions, this Fortran expression:

  (gdb) ptype var8%ptr_2%t2_array	--<A>
  Operation: STRUCTOP_STRUCT		--(1)
   Operation: STRUCTOP_STRUCT		--(2)
    Operation: OP_VAR_VALUE		--(3)
     Symbol: var8
     Block: 0x3980ac0
    String: ptr_2
   String: t2_array

And this C expression:

  (gdb) ptype ptr && ptr->a == 3	--<B>
  Operation: BINOP_LOGICAL_AND		--(4)
   Operation: OP_VAR_VALUE		--(5)
    Symbol: ptr
    Block: 0x45a2a00
   Operation: BINOP_EQUAL		--(6)
    Operation: STRUCTOP_PTR		--(7)
     Operation: OP_VAR_VALUE		--(8)
      Symbol: ptr
      Block: 0x45a2a00
     String: a
    Operation: OP_LONG			--(9)
     Type: int
     Constant: 0x0000000000000003

In expression <A> we should assume that t2_array is of dynamic type.
Nothing has dynamic type in expression <B>.

This is how GDB currently handles expression <A>, in all cases,
EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation
always returns the real value of the symbol, this is not forced to a
zero value even in EVAL_AVOID_SIDE_EFFECTS mode.  This means that (3),
(5), and (8) will always return a real lazy value for the symbol.

However a STRUCTOP_STRUCT will always replace its result with a
non-lazy, zero value with the same type as its result.  So (2) will
lookup the field ptr_2 and create a zero value with that type.  In
this case the type is a pointer to a dynamic type.

Then, when we evaluate (1) to figure out the resolved type of
t2_array, we need to read the types dynamic properties.  These
properties are stored in memory relative to the objects base address,
and the base address is in var8%ptr_2, which we already figured out
has the value zero.  GDB then evaluates the DWARF expressions that
take the base address, add an offset and dereference.  GDB then ends
up trying to access addresses like 0x16, 0x8, etc.

To fix this, I proposed changing STRUCTOP_STRUCT so that instead of
returning a zero value we instead returned the actual value
representing the structure's field in the target.  My thinking was
that GDB would not try to access the value's contents unless it needed
it to resolve a dynamic type.  This belief was incorrect.

Consider expression <B>.  We already know that (5) and (8) will return
real values for the symbols being referenced.  The BINOP_LOGICAL_AND,
operation (4) will evaluate both of its children in
EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required
for C++ operator lookup.  This means that even if the value of (5)
would result in the BINOP_LOGICAL_AND returning false (say, ptr is
NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode.

Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS
mode, operation (9) is easy, it just returns a value with the constant
packed into it, but (7) is where the problem lies.  Currently in GDB
this STRUCTOP_STRUCT will always return a non-lazy zero value of the
correct type.

When the results of (7) and (9) are back in the BINOP_LOGICAL_AND
operation (6), the two values are passed to value_equal which performs
the comparison and returns a result.  Note, the two things compared
here are the immediate value (9), and a non-lazy zero value from (7).

However, with my proposed patch operation (7) no longer returns a zero
value, instead it returns a lazy value representing the actual value
in target memory.  When we call value_equal in (6) this code causes
GDB to try and fetch the actual value from target memory.  If `ptr` is
NULL then this will cause GDB to access some invalid address at an
offset from zero, this will most likely fail, and cause GDB to throw
an error instead of returning the expected type.

And so, we can now describe the problem that we're facing.  The way
GDB's expression evaluator is currently written we assume, when in
EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child
operation can safely have its content read without throwing an
error.  If child operations start returning real values (instead of
the fake zero values), then this is simply not true.

If we wanted to work around this then we would need to rewrite almost
all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode
does not cause evaluation of an operation to try and read the value of
a child operation.  As an example, consider this current GDB code from
eval.c:

  struct value *
  eval_op_equal (struct type *expect_type, struct expression *exp,
  	       enum noside noside, enum exp_opcode op,
  	       struct value *arg1, struct value *arg2)
  {
    if (binop_user_defined_p (op, arg1, arg2))
      {
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      }
    else
      {
        binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
        int tem = value_equal (arg1, arg2);
        struct type *type = language_bool_type (exp->language_defn,
  					      exp->gdbarch);
        return value_from_longest (type, (LONGEST) tem);
      }
  }

We could change this function to be this:

  struct value *
  eval_op_equal (struct type *expect_type, struct expression *exp,
  	       enum noside noside, enum exp_opcode op,
  	       struct value *arg1, struct value *arg2)
  {
    if (binop_user_defined_p (op, arg1, arg2))
      {
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      }
    else
      {
        struct type *type = language_bool_type (exp->language_defn,
  					      exp->gdbarch);
        if (noside == EVAL_AVOID_SIDE_EFFECTS)
  	  return value_zero (type, VALUE_LVAL (arg1));
        else
  	{
  	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
  	  int tem = value_equal (arg1, arg2);
  	  return value_from_longest (type, (LONGEST) tem);
  	}
      }
  }

Now we don't call value_equal unless we really need to.  However, we
would need to make the same, or similar change to almost all
operations, which would be a big task, and might not be a direction we
wanted to take GDB in.

So, for now, I'm proposing we go with the more targeted, Fortran
specific solution, that does the minimal required in order to
correctly resolve the dynamic types.

gdb/ChangeLog:

	* 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.

gdb/testsuite/ChangeLog:

	* gdb.fortran/dynamic-ptype-whatis.exp: New file.
	* gdb.fortran/dynamic-ptype-whatis.f90: New file.
---
 gdb/ChangeLog                                 |  16 ++
 gdb/f-exp.h                                   |  16 ++
 gdb/f-exp.y                                   |   9 +-
 gdb/f-lang.c                                  |  40 +++++
 gdb/testsuite/ChangeLog                       |   5 +
 .../gdb.fortran/dynamic-ptype-whatis.exp      | 158 ++++++++++++++++++
 .../gdb.fortran/dynamic-ptype-whatis.f90      |  93 +++++++++++
 7 files changed, 333 insertions(+), 4 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
 create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90

diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index b3d0e0e9d54..955d1873f51 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -273,6 +273,22 @@ class fortran_bound_2arg
   { 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 ce11b09b18e..6608831a9a5 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 0c49420e1f1..7e921b99517 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/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
new file mode 100644
index 00000000000..d2ffd6d73f7
--- /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 00000000000..e56bf7952dc
--- /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
-- 
2.25.4

Re: [PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Andrew Burgess]

Ping!

Any feedback?

Thanks,
Andrew


* Andrew Burgess <andrew.burgess@embecosm.com> [2021-03-17 22:58:43 +0000]:

> This commit replaces this patch:
> 
>   https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html
> 
> which was itself a replacement for this patch:
> 
>   https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html
> 
> The motivation behind the original patch can be seen in the new test,
> which currently gives a GDB session like this:
> 
>   (gdb) ptype var8
>   type = Type type6
>       PTR TO -> ( Type type2 :: ptr_1 )
>       PTR TO -> ( Type type2 :: ptr_2 )
>   End Type type6
>   (gdb) ptype var8%ptr_2
>   type = PTR TO -> ( Type type2
>       integer(kind=4) :: spacer
>       Type type1, allocatable :: t2_array(:)	<------ Issue #1
>   End Type type2 )
>   (gdb) ptype var8%ptr_2%t2_array
>   Cannot access memory at address 0x38		<------ Issue #2
>   (gdb)
> 
> Issue #1: Here we see the abstract dynamic type, rather than the
> resolved concrete type.  Though in some cases the user might be
> interested in the abstract dynamic type, I think that in most cases
> showing the resolved concrete type will be of more use.  Plus, the
> user can always figure out the dynamic type (by source code inspection
> if nothing else) given the concrete type, but it is much harder to
> figure out the concrete type given only the dynamic type.
> 
> Issue #2: In this example, GDB evaluates the expression in
> EVAL_AVOID_SIDE_EFFECTS mode (due to ptype).  The value returned for
> var8%ptr_2 will be a non-lazy, zero value of the correct dynamic
> type.  However, when GDB asks about the type of t2_array this requires
> GDB to access the value of var8%ptr_2 in order to read the dynamic
> properties.  As this value was forced to zero (thanks to the use of
> EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base
> of zero plus some offset.
> 
> Both this patch, and my previous two attempts, have all tried to
> resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the
> result value with a zero value in some cases.
> 
> This new patch is influenced by how Ada handles its tagged typed.
> There are plenty of examples in ada-lang.c, but one specific case is
> ada_structop_operation::evaluate.  When GDB spots that we are dealing
> with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS
> mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode.
> 
> This commit handles two cases like this specifically for Fortran, a
> new fortran_structop_operation, and the already existing
> fortran_undetermined, which is where we handle array accesses.
> 
> In these two locations we spot when we are dealing with a dynamic type
> and re-evaluate the child operation in EVAL_NORMAL mode so that we
> are able to access the dynamic properties of the type.
> 
> The rest of this commit message is my attempt to record why my
> previous patches failed.
> 
> To understand my second patch, and why it failed lets consider two
> expressions, this Fortran expression:
> 
>   (gdb) ptype var8%ptr_2%t2_array	--<A>
>   Operation: STRUCTOP_STRUCT		--(1)
>    Operation: STRUCTOP_STRUCT		--(2)
>     Operation: OP_VAR_VALUE		--(3)
>      Symbol: var8
>      Block: 0x3980ac0
>     String: ptr_2
>    String: t2_array
> 
> And this C expression:
> 
>   (gdb) ptype ptr && ptr->a == 3	--<B>
>   Operation: BINOP_LOGICAL_AND		--(4)
>    Operation: OP_VAR_VALUE		--(5)
>     Symbol: ptr
>     Block: 0x45a2a00
>    Operation: BINOP_EQUAL		--(6)
>     Operation: STRUCTOP_PTR		--(7)
>      Operation: OP_VAR_VALUE		--(8)
>       Symbol: ptr
>       Block: 0x45a2a00
>      String: a
>     Operation: OP_LONG			--(9)
>      Type: int
>      Constant: 0x0000000000000003
> 
> In expression <A> we should assume that t2_array is of dynamic type.
> Nothing has dynamic type in expression <B>.
> 
> This is how GDB currently handles expression <A>, in all cases,
> EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation
> always returns the real value of the symbol, this is not forced to a
> zero value even in EVAL_AVOID_SIDE_EFFECTS mode.  This means that (3),
> (5), and (8) will always return a real lazy value for the symbol.
> 
> However a STRUCTOP_STRUCT will always replace its result with a
> non-lazy, zero value with the same type as its result.  So (2) will
> lookup the field ptr_2 and create a zero value with that type.  In
> this case the type is a pointer to a dynamic type.
> 
> Then, when we evaluate (1) to figure out the resolved type of
> t2_array, we need to read the types dynamic properties.  These
> properties are stored in memory relative to the objects base address,
> and the base address is in var8%ptr_2, which we already figured out
> has the value zero.  GDB then evaluates the DWARF expressions that
> take the base address, add an offset and dereference.  GDB then ends
> up trying to access addresses like 0x16, 0x8, etc.
> 
> To fix this, I proposed changing STRUCTOP_STRUCT so that instead of
> returning a zero value we instead returned the actual value
> representing the structure's field in the target.  My thinking was
> that GDB would not try to access the value's contents unless it needed
> it to resolve a dynamic type.  This belief was incorrect.
> 
> Consider expression <B>.  We already know that (5) and (8) will return
> real values for the symbols being referenced.  The BINOP_LOGICAL_AND,
> operation (4) will evaluate both of its children in
> EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required
> for C++ operator lookup.  This means that even if the value of (5)
> would result in the BINOP_LOGICAL_AND returning false (say, ptr is
> NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode.
> 
> Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS
> mode, operation (9) is easy, it just returns a value with the constant
> packed into it, but (7) is where the problem lies.  Currently in GDB
> this STRUCTOP_STRUCT will always return a non-lazy zero value of the
> correct type.
> 
> When the results of (7) and (9) are back in the BINOP_LOGICAL_AND
> operation (6), the two values are passed to value_equal which performs
> the comparison and returns a result.  Note, the two things compared
> here are the immediate value (9), and a non-lazy zero value from (7).
> 
> However, with my proposed patch operation (7) no longer returns a zero
> value, instead it returns a lazy value representing the actual value
> in target memory.  When we call value_equal in (6) this code causes
> GDB to try and fetch the actual value from target memory.  If `ptr` is
> NULL then this will cause GDB to access some invalid address at an
> offset from zero, this will most likely fail, and cause GDB to throw
> an error instead of returning the expected type.
> 
> And so, we can now describe the problem that we're facing.  The way
> GDB's expression evaluator is currently written we assume, when in
> EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child
> operation can safely have its content read without throwing an
> error.  If child operations start returning real values (instead of
> the fake zero values), then this is simply not true.
> 
> If we wanted to work around this then we would need to rewrite almost
> all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode
> does not cause evaluation of an operation to try and read the value of
> a child operation.  As an example, consider this current GDB code from
> eval.c:
> 
>   struct value *
>   eval_op_equal (struct type *expect_type, struct expression *exp,
>   	       enum noside noside, enum exp_opcode op,
>   	       struct value *arg1, struct value *arg2)
>   {
>     if (binop_user_defined_p (op, arg1, arg2))
>       {
>         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
>       }
>     else
>       {
>         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
>         int tem = value_equal (arg1, arg2);
>         struct type *type = language_bool_type (exp->language_defn,
>   					      exp->gdbarch);
>         return value_from_longest (type, (LONGEST) tem);
>       }
>   }
> 
> We could change this function to be this:
> 
>   struct value *
>   eval_op_equal (struct type *expect_type, struct expression *exp,
>   	       enum noside noside, enum exp_opcode op,
>   	       struct value *arg1, struct value *arg2)
>   {
>     if (binop_user_defined_p (op, arg1, arg2))
>       {
>         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
>       }
>     else
>       {
>         struct type *type = language_bool_type (exp->language_defn,
>   					      exp->gdbarch);
>         if (noside == EVAL_AVOID_SIDE_EFFECTS)
>   	  return value_zero (type, VALUE_LVAL (arg1));
>         else
>   	{
>   	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
>   	  int tem = value_equal (arg1, arg2);
>   	  return value_from_longest (type, (LONGEST) tem);
>   	}
>       }
>   }
> 
> Now we don't call value_equal unless we really need to.  However, we
> would need to make the same, or similar change to almost all
> operations, which would be a big task, and might not be a direction we
> wanted to take GDB in.
> 
> So, for now, I'm proposing we go with the more targeted, Fortran
> specific solution, that does the minimal required in order to
> correctly resolve the dynamic types.
> 
> gdb/ChangeLog:
> 
> 	* 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.
> 
> gdb/testsuite/ChangeLog:
> 
> 	* gdb.fortran/dynamic-ptype-whatis.exp: New file.
> 	* gdb.fortran/dynamic-ptype-whatis.f90: New file.
> ---
>  gdb/ChangeLog                                 |  16 ++
>  gdb/f-exp.h                                   |  16 ++
>  gdb/f-exp.y                                   |   9 +-
>  gdb/f-lang.c                                  |  40 +++++
>  gdb/testsuite/ChangeLog                       |   5 +
>  .../gdb.fortran/dynamic-ptype-whatis.exp      | 158 ++++++++++++++++++
>  .../gdb.fortran/dynamic-ptype-whatis.f90      |  93 +++++++++++
>  7 files changed, 333 insertions(+), 4 deletions(-)
>  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
>  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90
> 
> diff --git a/gdb/f-exp.h b/gdb/f-exp.h
> index b3d0e0e9d54..955d1873f51 100644
> --- a/gdb/f-exp.h
> +++ b/gdb/f-exp.h
> @@ -273,6 +273,22 @@ class fortran_bound_2arg
>    { 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 ce11b09b18e..6608831a9a5 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 0c49420e1f1..7e921b99517 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/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
> new file mode 100644
> index 00000000000..d2ffd6d73f7
> --- /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 00000000000..e56bf7952dc
> --- /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
> -- 
> 2.25.4
> 

Re: [PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Tom Tromey]

>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:

Andrew> Ping!
Andrew> Any feedback?

I lost track of which one I should reply to, but fwiw this looks fine to
me.

Tom

Re: [PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Andrew Burgess]

* Andrew Burgess <andrew.burgess@embecosm.com> [2021-03-31 21:12:45 +0100]:

> Ping!
> 
> Any feedback?

Ignore this one please.  Sorry for the noise.

Andrew



> 
> 
> * Andrew Burgess <andrew.burgess@embecosm.com> [2021-03-22 17:44:47 +0000]:
> 
> > This commit replaces this patch:
> > 
> >   https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html
> > 
> > which was itself a replacement for this patch:
> > 
> >   https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html
> > 
> > The motivation behind the original patch can be seen in the new test,
> > which currently gives a GDB session like this:
> > 
> >   (gdb) ptype var8
> >   type = Type type6
> >       PTR TO -> ( Type type2 :: ptr_1 )
> >       PTR TO -> ( Type type2 :: ptr_2 )
> >   End Type type6
> >   (gdb) ptype var8%ptr_2
> >   type = PTR TO -> ( Type type2
> >       integer(kind=4) :: spacer
> >       Type type1, allocatable :: t2_array(:)	<------ Issue #1
> >   End Type type2 )
> >   (gdb) ptype var8%ptr_2%t2_array
> >   Cannot access memory at address 0x38		<------ Issue #2
> >   (gdb)
> > 
> > Issue #1: Here we see the abstract dynamic type, rather than the
> > resolved concrete type.  Though in some cases the user might be
> > interested in the abstract dynamic type, I think that in most cases
> > showing the resolved concrete type will be of more use.  Plus, the
> > user can always figure out the dynamic type (by source code inspection
> > if nothing else) given the concrete type, but it is much harder to
> > figure out the concrete type given only the dynamic type.
> > 
> > Issue #2: In this example, GDB evaluates the expression in
> > EVAL_AVOID_SIDE_EFFECTS mode (due to ptype).  The value returned for
> > var8%ptr_2 will be a non-lazy, zero value of the correct dynamic
> > type.  However, when GDB asks about the type of t2_array this requires
> > GDB to access the value of var8%ptr_2 in order to read the dynamic
> > properties.  As this value was forced to zero (thanks to the use of
> > EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base
> > of zero plus some offset.
> > 
> > Both this patch, and my previous two attempts, have all tried to
> > resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the
> > result value with a zero value in some cases.
> > 
> > This new patch is influenced by how Ada handles its tagged typed.
> > There are plenty of examples in ada-lang.c, but one specific case is
> > ada_structop_operation::evaluate.  When GDB spots that we are dealing
> > with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS
> > mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode.
> > 
> > This commit handles two cases like this specifically for Fortran, a
> > new fortran_structop_operation, and the already existing
> > fortran_undetermined, which is where we handle array accesses.
> > 
> > In these two locations we spot when we are dealing with a dynamic type
> > and re-evaluate the child operation in EVAL_NORMAL mode so that we
> > are able to access the dynamic properties of the type.
> > 
> > The rest of this commit message is my attempt to record why my
> > previous patches failed.
> > 
> > To understand my second patch, and why it failed lets consider two
> > expressions, this Fortran expression:
> > 
> >   (gdb) ptype var8%ptr_2%t2_array	--<A>
> >   Operation: STRUCTOP_STRUCT		--(1)
> >    Operation: STRUCTOP_STRUCT		--(2)
> >     Operation: OP_VAR_VALUE		--(3)
> >      Symbol: var8
> >      Block: 0x3980ac0
> >     String: ptr_2
> >    String: t2_array
> > 
> > And this C expression:
> > 
> >   (gdb) ptype ptr && ptr->a == 3	--<B>
> >   Operation: BINOP_LOGICAL_AND		--(4)
> >    Operation: OP_VAR_VALUE		--(5)
> >     Symbol: ptr
> >     Block: 0x45a2a00
> >    Operation: BINOP_EQUAL		--(6)
> >     Operation: STRUCTOP_PTR		--(7)
> >      Operation: OP_VAR_VALUE		--(8)
> >       Symbol: ptr
> >       Block: 0x45a2a00
> >      String: a
> >     Operation: OP_LONG			--(9)
> >      Type: int
> >      Constant: 0x0000000000000003
> > 
> > In expression <A> we should assume that t2_array is of dynamic type.
> > Nothing has dynamic type in expression <B>.
> > 
> > This is how GDB currently handles expression <A>, in all cases,
> > EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation
> > always returns the real value of the symbol, this is not forced to a
> > zero value even in EVAL_AVOID_SIDE_EFFECTS mode.  This means that (3),
> > (5), and (8) will always return a real lazy value for the symbol.
> > 
> > However a STRUCTOP_STRUCT will always replace its result with a
> > non-lazy, zero value with the same type as its result.  So (2) will
> > lookup the field ptr_2 and create a zero value with that type.  In
> > this case the type is a pointer to a dynamic type.
> > 
> > Then, when we evaluate (1) to figure out the resolved type of
> > t2_array, we need to read the types dynamic properties.  These
> > properties are stored in memory relative to the objects base address,
> > and the base address is in var8%ptr_2, which we already figured out
> > has the value zero.  GDB then evaluates the DWARF expressions that
> > take the base address, add an offset and dereference.  GDB then ends
> > up trying to access addresses like 0x16, 0x8, etc.
> > 
> > To fix this, I proposed changing STRUCTOP_STRUCT so that instead of
> > returning a zero value we instead returned the actual value
> > representing the structure's field in the target.  My thinking was
> > that GDB would not try to access the value's contents unless it needed
> > it to resolve a dynamic type.  This belief was incorrect.
> > 
> > Consider expression <B>.  We already know that (5) and (8) will return
> > real values for the symbols being referenced.  The BINOP_LOGICAL_AND,
> > operation (4) will evaluate both of its children in
> > EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required
> > for C++ operator lookup.  This means that even if the value of (5)
> > would result in the BINOP_LOGICAL_AND returning false (say, ptr is
> > NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode.
> > 
> > Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS
> > mode, operation (9) is easy, it just returns a value with the constant
> > packed into it, but (7) is where the problem lies.  Currently in GDB
> > this STRUCTOP_STRUCT will always return a non-lazy zero value of the
> > correct type.
> > 
> > When the results of (7) and (9) are back in the BINOP_LOGICAL_AND
> > operation (6), the two values are passed to value_equal which performs
> > the comparison and returns a result.  Note, the two things compared
> > here are the immediate value (9), and a non-lazy zero value from (7).
> > 
> > However, with my proposed patch operation (7) no longer returns a zero
> > value, instead it returns a lazy value representing the actual value
> > in target memory.  When we call value_equal in (6) this code causes
> > GDB to try and fetch the actual value from target memory.  If `ptr` is
> > NULL then this will cause GDB to access some invalid address at an
> > offset from zero, this will most likely fail, and cause GDB to throw
> > an error instead of returning the expected type.
> > 
> > And so, we can now describe the problem that we're facing.  The way
> > GDB's expression evaluator is currently written we assume, when in
> > EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child
> > operation can safely have its content read without throwing an
> > error.  If child operations start returning real values (instead of
> > the fake zero values), then this is simply not true.
> > 
> > If we wanted to work around this then we would need to rewrite almost
> > all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode
> > does not cause evaluation of an operation to try and read the value of
> > a child operation.  As an example, consider this current GDB code from
> > eval.c:
> > 
> >   struct value *
> >   eval_op_equal (struct type *expect_type, struct expression *exp,
> >   	       enum noside noside, enum exp_opcode op,
> >   	       struct value *arg1, struct value *arg2)
> >   {
> >     if (binop_user_defined_p (op, arg1, arg2))
> >       {
> >         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
> >       }
> >     else
> >       {
> >         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
> >         int tem = value_equal (arg1, arg2);
> >         struct type *type = language_bool_type (exp->language_defn,
> >   					      exp->gdbarch);
> >         return value_from_longest (type, (LONGEST) tem);
> >       }
> >   }
> > 
> > We could change this function to be this:
> > 
> >   struct value *
> >   eval_op_equal (struct type *expect_type, struct expression *exp,
> >   	       enum noside noside, enum exp_opcode op,
> >   	       struct value *arg1, struct value *arg2)
> >   {
> >     if (binop_user_defined_p (op, arg1, arg2))
> >       {
> >         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
> >       }
> >     else
> >       {
> >         struct type *type = language_bool_type (exp->language_defn,
> >   					      exp->gdbarch);
> >         if (noside == EVAL_AVOID_SIDE_EFFECTS)
> >   	  return value_zero (type, VALUE_LVAL (arg1));
> >         else
> >   	{
> >   	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
> >   	  int tem = value_equal (arg1, arg2);
> >   	  return value_from_longest (type, (LONGEST) tem);
> >   	}
> >       }
> >   }
> > 
> > Now we don't call value_equal unless we really need to.  However, we
> > would need to make the same, or similar change to almost all
> > operations, which would be a big task, and might not be a direction we
> > wanted to take GDB in.
> > 
> > So, for now, I'm proposing we go with the more targeted, Fortran
> > specific solution, that does the minimal required in order to
> > correctly resolve the dynamic types.
> > 
> > gdb/ChangeLog:
> > 
> > 	* 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.
> > 
> > gdb/testsuite/ChangeLog:
> > 
> > 	* gdb.fortran/dynamic-ptype-whatis.exp: New file.
> > 	* gdb.fortran/dynamic-ptype-whatis.f90: New file.
> > ---
> >  gdb/ChangeLog                                 |  16 ++
> >  gdb/f-exp.h                                   |  16 ++
> >  gdb/f-exp.y                                   |   9 +-
> >  gdb/f-lang.c                                  |  40 +++++
> >  gdb/testsuite/ChangeLog                       |   5 +
> >  .../gdb.fortran/dynamic-ptype-whatis.exp      | 158 ++++++++++++++++++
> >  .../gdb.fortran/dynamic-ptype-whatis.f90      |  93 +++++++++++
> >  7 files changed, 333 insertions(+), 4 deletions(-)
> >  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
> >  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90
> > 
> > diff --git a/gdb/f-exp.h b/gdb/f-exp.h
> > index b3d0e0e9d54..955d1873f51 100644
> > --- a/gdb/f-exp.h
> > +++ b/gdb/f-exp.h
> > @@ -273,6 +273,22 @@ class fortran_bound_2arg
> >    { 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 ce11b09b18e..6608831a9a5 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 0c49420e1f1..7e921b99517 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/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
> > new file mode 100644
> > index 00000000000..d2ffd6d73f7
> > --- /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 00000000000..e56bf7952dc
> > --- /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
> > -- 
> > 2.25.4
> > 

Re: [PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Andrew Burgess]

Ping!

Any feedback?

Thanks,
Andrew


* Andrew Burgess <andrew.burgess@embecosm.com> [2021-03-22 17:44:47 +0000]:

> This commit replaces this patch:
> 
>   https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html
> 
> which was itself a replacement for this patch:
> 
>   https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html
> 
> The motivation behind the original patch can be seen in the new test,
> which currently gives a GDB session like this:
> 
>   (gdb) ptype var8
>   type = Type type6
>       PTR TO -> ( Type type2 :: ptr_1 )
>       PTR TO -> ( Type type2 :: ptr_2 )
>   End Type type6
>   (gdb) ptype var8%ptr_2
>   type = PTR TO -> ( Type type2
>       integer(kind=4) :: spacer
>       Type type1, allocatable :: t2_array(:)	<------ Issue #1
>   End Type type2 )
>   (gdb) ptype var8%ptr_2%t2_array
>   Cannot access memory at address 0x38		<------ Issue #2
>   (gdb)
> 
> Issue #1: Here we see the abstract dynamic type, rather than the
> resolved concrete type.  Though in some cases the user might be
> interested in the abstract dynamic type, I think that in most cases
> showing the resolved concrete type will be of more use.  Plus, the
> user can always figure out the dynamic type (by source code inspection
> if nothing else) given the concrete type, but it is much harder to
> figure out the concrete type given only the dynamic type.
> 
> Issue #2: In this example, GDB evaluates the expression in
> EVAL_AVOID_SIDE_EFFECTS mode (due to ptype).  The value returned for
> var8%ptr_2 will be a non-lazy, zero value of the correct dynamic
> type.  However, when GDB asks about the type of t2_array this requires
> GDB to access the value of var8%ptr_2 in order to read the dynamic
> properties.  As this value was forced to zero (thanks to the use of
> EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base
> of zero plus some offset.
> 
> Both this patch, and my previous two attempts, have all tried to
> resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the
> result value with a zero value in some cases.
> 
> This new patch is influenced by how Ada handles its tagged typed.
> There are plenty of examples in ada-lang.c, but one specific case is
> ada_structop_operation::evaluate.  When GDB spots that we are dealing
> with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS
> mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode.
> 
> This commit handles two cases like this specifically for Fortran, a
> new fortran_structop_operation, and the already existing
> fortran_undetermined, which is where we handle array accesses.
> 
> In these two locations we spot when we are dealing with a dynamic type
> and re-evaluate the child operation in EVAL_NORMAL mode so that we
> are able to access the dynamic properties of the type.
> 
> The rest of this commit message is my attempt to record why my
> previous patches failed.
> 
> To understand my second patch, and why it failed lets consider two
> expressions, this Fortran expression:
> 
>   (gdb) ptype var8%ptr_2%t2_array	--<A>
>   Operation: STRUCTOP_STRUCT		--(1)
>    Operation: STRUCTOP_STRUCT		--(2)
>     Operation: OP_VAR_VALUE		--(3)
>      Symbol: var8
>      Block: 0x3980ac0
>     String: ptr_2
>    String: t2_array
> 
> And this C expression:
> 
>   (gdb) ptype ptr && ptr->a == 3	--<B>
>   Operation: BINOP_LOGICAL_AND		--(4)
>    Operation: OP_VAR_VALUE		--(5)
>     Symbol: ptr
>     Block: 0x45a2a00
>    Operation: BINOP_EQUAL		--(6)
>     Operation: STRUCTOP_PTR		--(7)
>      Operation: OP_VAR_VALUE		--(8)
>       Symbol: ptr
>       Block: 0x45a2a00
>      String: a
>     Operation: OP_LONG			--(9)
>      Type: int
>      Constant: 0x0000000000000003
> 
> In expression <A> we should assume that t2_array is of dynamic type.
> Nothing has dynamic type in expression <B>.
> 
> This is how GDB currently handles expression <A>, in all cases,
> EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation
> always returns the real value of the symbol, this is not forced to a
> zero value even in EVAL_AVOID_SIDE_EFFECTS mode.  This means that (3),
> (5), and (8) will always return a real lazy value for the symbol.
> 
> However a STRUCTOP_STRUCT will always replace its result with a
> non-lazy, zero value with the same type as its result.  So (2) will
> lookup the field ptr_2 and create a zero value with that type.  In
> this case the type is a pointer to a dynamic type.
> 
> Then, when we evaluate (1) to figure out the resolved type of
> t2_array, we need to read the types dynamic properties.  These
> properties are stored in memory relative to the objects base address,
> and the base address is in var8%ptr_2, which we already figured out
> has the value zero.  GDB then evaluates the DWARF expressions that
> take the base address, add an offset and dereference.  GDB then ends
> up trying to access addresses like 0x16, 0x8, etc.
> 
> To fix this, I proposed changing STRUCTOP_STRUCT so that instead of
> returning a zero value we instead returned the actual value
> representing the structure's field in the target.  My thinking was
> that GDB would not try to access the value's contents unless it needed
> it to resolve a dynamic type.  This belief was incorrect.
> 
> Consider expression <B>.  We already know that (5) and (8) will return
> real values for the symbols being referenced.  The BINOP_LOGICAL_AND,
> operation (4) will evaluate both of its children in
> EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required
> for C++ operator lookup.  This means that even if the value of (5)
> would result in the BINOP_LOGICAL_AND returning false (say, ptr is
> NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode.
> 
> Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS
> mode, operation (9) is easy, it just returns a value with the constant
> packed into it, but (7) is where the problem lies.  Currently in GDB
> this STRUCTOP_STRUCT will always return a non-lazy zero value of the
> correct type.
> 
> When the results of (7) and (9) are back in the BINOP_LOGICAL_AND
> operation (6), the two values are passed to value_equal which performs
> the comparison and returns a result.  Note, the two things compared
> here are the immediate value (9), and a non-lazy zero value from (7).
> 
> However, with my proposed patch operation (7) no longer returns a zero
> value, instead it returns a lazy value representing the actual value
> in target memory.  When we call value_equal in (6) this code causes
> GDB to try and fetch the actual value from target memory.  If `ptr` is
> NULL then this will cause GDB to access some invalid address at an
> offset from zero, this will most likely fail, and cause GDB to throw
> an error instead of returning the expected type.
> 
> And so, we can now describe the problem that we're facing.  The way
> GDB's expression evaluator is currently written we assume, when in
> EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child
> operation can safely have its content read without throwing an
> error.  If child operations start returning real values (instead of
> the fake zero values), then this is simply not true.
> 
> If we wanted to work around this then we would need to rewrite almost
> all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode
> does not cause evaluation of an operation to try and read the value of
> a child operation.  As an example, consider this current GDB code from
> eval.c:
> 
>   struct value *
>   eval_op_equal (struct type *expect_type, struct expression *exp,
>   	       enum noside noside, enum exp_opcode op,
>   	       struct value *arg1, struct value *arg2)
>   {
>     if (binop_user_defined_p (op, arg1, arg2))
>       {
>         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
>       }
>     else
>       {
>         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
>         int tem = value_equal (arg1, arg2);
>         struct type *type = language_bool_type (exp->language_defn,
>   					      exp->gdbarch);
>         return value_from_longest (type, (LONGEST) tem);
>       }
>   }
> 
> We could change this function to be this:
> 
>   struct value *
>   eval_op_equal (struct type *expect_type, struct expression *exp,
>   	       enum noside noside, enum exp_opcode op,
>   	       struct value *arg1, struct value *arg2)
>   {
>     if (binop_user_defined_p (op, arg1, arg2))
>       {
>         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
>       }
>     else
>       {
>         struct type *type = language_bool_type (exp->language_defn,
>   					      exp->gdbarch);
>         if (noside == EVAL_AVOID_SIDE_EFFECTS)
>   	  return value_zero (type, VALUE_LVAL (arg1));
>         else
>   	{
>   	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
>   	  int tem = value_equal (arg1, arg2);
>   	  return value_from_longest (type, (LONGEST) tem);
>   	}
>       }
>   }
> 
> Now we don't call value_equal unless we really need to.  However, we
> would need to make the same, or similar change to almost all
> operations, which would be a big task, and might not be a direction we
> wanted to take GDB in.
> 
> So, for now, I'm proposing we go with the more targeted, Fortran
> specific solution, that does the minimal required in order to
> correctly resolve the dynamic types.
> 
> gdb/ChangeLog:
> 
> 	* 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.
> 
> gdb/testsuite/ChangeLog:
> 
> 	* gdb.fortran/dynamic-ptype-whatis.exp: New file.
> 	* gdb.fortran/dynamic-ptype-whatis.f90: New file.
> ---
>  gdb/ChangeLog                                 |  16 ++
>  gdb/f-exp.h                                   |  16 ++
>  gdb/f-exp.y                                   |   9 +-
>  gdb/f-lang.c                                  |  40 +++++
>  gdb/testsuite/ChangeLog                       |   5 +
>  .../gdb.fortran/dynamic-ptype-whatis.exp      | 158 ++++++++++++++++++
>  .../gdb.fortran/dynamic-ptype-whatis.f90      |  93 +++++++++++
>  7 files changed, 333 insertions(+), 4 deletions(-)
>  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
>  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90
> 
> diff --git a/gdb/f-exp.h b/gdb/f-exp.h
> index b3d0e0e9d54..955d1873f51 100644
> --- a/gdb/f-exp.h
> +++ b/gdb/f-exp.h
> @@ -273,6 +273,22 @@ class fortran_bound_2arg
>    { 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 ce11b09b18e..6608831a9a5 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 0c49420e1f1..7e921b99517 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/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
> new file mode 100644
> index 00000000000..d2ffd6d73f7
> --- /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 00000000000..e56bf7952dc
> --- /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
> -- 
> 2.25.4
> 

Re: [PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Andrew Burgess]

I realise I loved this patch so much I posted it twice.  Sorry about
that.

Please leave any feedback on the other version, here:

  https://sourceware.org/pipermail/gdb-patches/2021-March/177048.html

Thanks,
Andrew


* Andrew Burgess <andrew.burgess@embecosm.com> [2021-03-22 17:44:47 +0000]:

> This commit replaces this patch:
> 
>   https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html
> 
> which was itself a replacement for this patch:
> 
>   https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html
> 
> The motivation behind the original patch can be seen in the new test,
> which currently gives a GDB session like this:
> 
>   (gdb) ptype var8
>   type = Type type6
>       PTR TO -> ( Type type2 :: ptr_1 )
>       PTR TO -> ( Type type2 :: ptr_2 )
>   End Type type6
>   (gdb) ptype var8%ptr_2
>   type = PTR TO -> ( Type type2
>       integer(kind=4) :: spacer
>       Type type1, allocatable :: t2_array(:)	<------ Issue #1
>   End Type type2 )
>   (gdb) ptype var8%ptr_2%t2_array
>   Cannot access memory at address 0x38		<------ Issue #2
>   (gdb)
> 
> Issue #1: Here we see the abstract dynamic type, rather than the
> resolved concrete type.  Though in some cases the user might be
> interested in the abstract dynamic type, I think that in most cases
> showing the resolved concrete type will be of more use.  Plus, the
> user can always figure out the dynamic type (by source code inspection
> if nothing else) given the concrete type, but it is much harder to
> figure out the concrete type given only the dynamic type.
> 
> Issue #2: In this example, GDB evaluates the expression in
> EVAL_AVOID_SIDE_EFFECTS mode (due to ptype).  The value returned for
> var8%ptr_2 will be a non-lazy, zero value of the correct dynamic
> type.  However, when GDB asks about the type of t2_array this requires
> GDB to access the value of var8%ptr_2 in order to read the dynamic
> properties.  As this value was forced to zero (thanks to the use of
> EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base
> of zero plus some offset.
> 
> Both this patch, and my previous two attempts, have all tried to
> resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the
> result value with a zero value in some cases.
> 
> This new patch is influenced by how Ada handles its tagged typed.
> There are plenty of examples in ada-lang.c, but one specific case is
> ada_structop_operation::evaluate.  When GDB spots that we are dealing
> with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS
> mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode.
> 
> This commit handles two cases like this specifically for Fortran, a
> new fortran_structop_operation, and the already existing
> fortran_undetermined, which is where we handle array accesses.
> 
> In these two locations we spot when we are dealing with a dynamic type
> and re-evaluate the child operation in EVAL_NORMAL mode so that we
> are able to access the dynamic properties of the type.
> 
> The rest of this commit message is my attempt to record why my
> previous patches failed.
> 
> To understand my second patch, and why it failed lets consider two
> expressions, this Fortran expression:
> 
>   (gdb) ptype var8%ptr_2%t2_array	--<A>
>   Operation: STRUCTOP_STRUCT		--(1)
>    Operation: STRUCTOP_STRUCT		--(2)
>     Operation: OP_VAR_VALUE		--(3)
>      Symbol: var8
>      Block: 0x3980ac0
>     String: ptr_2
>    String: t2_array
> 
> And this C expression:
> 
>   (gdb) ptype ptr && ptr->a == 3	--<B>
>   Operation: BINOP_LOGICAL_AND		--(4)
>    Operation: OP_VAR_VALUE		--(5)
>     Symbol: ptr
>     Block: 0x45a2a00
>    Operation: BINOP_EQUAL		--(6)
>     Operation: STRUCTOP_PTR		--(7)
>      Operation: OP_VAR_VALUE		--(8)
>       Symbol: ptr
>       Block: 0x45a2a00
>      String: a
>     Operation: OP_LONG			--(9)
>      Type: int
>      Constant: 0x0000000000000003
> 
> In expression <A> we should assume that t2_array is of dynamic type.
> Nothing has dynamic type in expression <B>.
> 
> This is how GDB currently handles expression <A>, in all cases,
> EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation
> always returns the real value of the symbol, this is not forced to a
> zero value even in EVAL_AVOID_SIDE_EFFECTS mode.  This means that (3),
> (5), and (8) will always return a real lazy value for the symbol.
> 
> However a STRUCTOP_STRUCT will always replace its result with a
> non-lazy, zero value with the same type as its result.  So (2) will
> lookup the field ptr_2 and create a zero value with that type.  In
> this case the type is a pointer to a dynamic type.
> 
> Then, when we evaluate (1) to figure out the resolved type of
> t2_array, we need to read the types dynamic properties.  These
> properties are stored in memory relative to the objects base address,
> and the base address is in var8%ptr_2, which we already figured out
> has the value zero.  GDB then evaluates the DWARF expressions that
> take the base address, add an offset and dereference.  GDB then ends
> up trying to access addresses like 0x16, 0x8, etc.
> 
> To fix this, I proposed changing STRUCTOP_STRUCT so that instead of
> returning a zero value we instead returned the actual value
> representing the structure's field in the target.  My thinking was
> that GDB would not try to access the value's contents unless it needed
> it to resolve a dynamic type.  This belief was incorrect.
> 
> Consider expression <B>.  We already know that (5) and (8) will return
> real values for the symbols being referenced.  The BINOP_LOGICAL_AND,
> operation (4) will evaluate both of its children in
> EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required
> for C++ operator lookup.  This means that even if the value of (5)
> would result in the BINOP_LOGICAL_AND returning false (say, ptr is
> NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode.
> 
> Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS
> mode, operation (9) is easy, it just returns a value with the constant
> packed into it, but (7) is where the problem lies.  Currently in GDB
> this STRUCTOP_STRUCT will always return a non-lazy zero value of the
> correct type.
> 
> When the results of (7) and (9) are back in the BINOP_LOGICAL_AND
> operation (6), the two values are passed to value_equal which performs
> the comparison and returns a result.  Note, the two things compared
> here are the immediate value (9), and a non-lazy zero value from (7).
> 
> However, with my proposed patch operation (7) no longer returns a zero
> value, instead it returns a lazy value representing the actual value
> in target memory.  When we call value_equal in (6) this code causes
> GDB to try and fetch the actual value from target memory.  If `ptr` is
> NULL then this will cause GDB to access some invalid address at an
> offset from zero, this will most likely fail, and cause GDB to throw
> an error instead of returning the expected type.
> 
> And so, we can now describe the problem that we're facing.  The way
> GDB's expression evaluator is currently written we assume, when in
> EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child
> operation can safely have its content read without throwing an
> error.  If child operations start returning real values (instead of
> the fake zero values), then this is simply not true.
> 
> If we wanted to work around this then we would need to rewrite almost
> all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode
> does not cause evaluation of an operation to try and read the value of
> a child operation.  As an example, consider this current GDB code from
> eval.c:
> 
>   struct value *
>   eval_op_equal (struct type *expect_type, struct expression *exp,
>   	       enum noside noside, enum exp_opcode op,
>   	       struct value *arg1, struct value *arg2)
>   {
>     if (binop_user_defined_p (op, arg1, arg2))
>       {
>         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
>       }
>     else
>       {
>         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
>         int tem = value_equal (arg1, arg2);
>         struct type *type = language_bool_type (exp->language_defn,
>   					      exp->gdbarch);
>         return value_from_longest (type, (LONGEST) tem);
>       }
>   }
> 
> We could change this function to be this:
> 
>   struct value *
>   eval_op_equal (struct type *expect_type, struct expression *exp,
>   	       enum noside noside, enum exp_opcode op,
>   	       struct value *arg1, struct value *arg2)
>   {
>     if (binop_user_defined_p (op, arg1, arg2))
>       {
>         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
>       }
>     else
>       {
>         struct type *type = language_bool_type (exp->language_defn,
>   					      exp->gdbarch);
>         if (noside == EVAL_AVOID_SIDE_EFFECTS)
>   	  return value_zero (type, VALUE_LVAL (arg1));
>         else
>   	{
>   	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
>   	  int tem = value_equal (arg1, arg2);
>   	  return value_from_longest (type, (LONGEST) tem);
>   	}
>       }
>   }
> 
> Now we don't call value_equal unless we really need to.  However, we
> would need to make the same, or similar change to almost all
> operations, which would be a big task, and might not be a direction we
> wanted to take GDB in.
> 
> So, for now, I'm proposing we go with the more targeted, Fortran
> specific solution, that does the minimal required in order to
> correctly resolve the dynamic types.
> 
> gdb/ChangeLog:
> 
> 	* 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.
> 
> gdb/testsuite/ChangeLog:
> 
> 	* gdb.fortran/dynamic-ptype-whatis.exp: New file.
> 	* gdb.fortran/dynamic-ptype-whatis.f90: New file.
> ---
>  gdb/ChangeLog                                 |  16 ++
>  gdb/f-exp.h                                   |  16 ++
>  gdb/f-exp.y                                   |   9 +-
>  gdb/f-lang.c                                  |  40 +++++
>  gdb/testsuite/ChangeLog                       |   5 +
>  .../gdb.fortran/dynamic-ptype-whatis.exp      | 158 ++++++++++++++++++
>  .../gdb.fortran/dynamic-ptype-whatis.f90      |  93 +++++++++++
>  7 files changed, 333 insertions(+), 4 deletions(-)
>  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
>  create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90
> 
> diff --git a/gdb/f-exp.h b/gdb/f-exp.h
> index b3d0e0e9d54..955d1873f51 100644
> --- a/gdb/f-exp.h
> +++ b/gdb/f-exp.h
> @@ -273,6 +273,22 @@ class fortran_bound_2arg
>    { 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 ce11b09b18e..6608831a9a5 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 0c49420e1f1..7e921b99517 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/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
> new file mode 100644
> index 00000000000..d2ffd6d73f7
> --- /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 00000000000..e56bf7952dc
> --- /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
> -- 
> 2.25.4
> 

[PATCH] gdb/fortran: handle dynamic types within arrays and structures

[Andrew Burgess]

This commit replaces this patch:

  https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html

which was itself a replacement for this patch:

  https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html

The motivation behind the original patch can be seen in the new test,
which currently gives a GDB session like this:

  (gdb) ptype var8
  type = Type type6
      PTR TO -> ( Type type2 :: ptr_1 )
      PTR TO -> ( Type type2 :: ptr_2 )
  End Type type6
  (gdb) ptype var8%ptr_2
  type = PTR TO -> ( Type type2
      integer(kind=4) :: spacer
      Type type1, allocatable :: t2_array(:)	<------ Issue #1
  End Type type2 )
  (gdb) ptype var8%ptr_2%t2_array
  Cannot access memory at address 0x38		<------ Issue #2
  (gdb)

Issue #1: Here we see the abstract dynamic type, rather than the
resolved concrete type.  Though in some cases the user might be
interested in the abstract dynamic type, I think that in most cases
showing the resolved concrete type will be of more use.  Plus, the
user can always figure out the dynamic type (by source code inspection
if nothing else) given the concrete type, but it is much harder to
figure out the concrete type given only the dynamic type.

Issue #2: In this example, GDB evaluates the expression in
EVAL_AVOID_SIDE_EFFECTS mode (due to ptype).  The value returned for
var8%ptr_2 will be a non-lazy, zero value of the correct dynamic
type.  However, when GDB asks about the type of t2_array this requires
GDB to access the value of var8%ptr_2 in order to read the dynamic
properties.  As this value was forced to zero (thanks to the use of
EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base
of zero plus some offset.

Both this patch, and my previous two attempts, have all tried to
resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the
result value with a zero value in some cases.

This new patch is influenced by how Ada handles its tagged typed.
There are plenty of examples in ada-lang.c, but one specific case is
ada_structop_operation::evaluate.  When GDB spots that we are dealing
with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS
mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode.

This commit handles two cases like this specifically for Fortran, a
new fortran_structop_operation, and the already existing
fortran_undetermined, which is where we handle array accesses.

In these two locations we spot when we are dealing with a dynamic type
and re-evaluate the child operation in EVAL_NORMAL mode so that we
are able to access the dynamic properties of the type.

The rest of this commit message is my attempt to record why my
previous patches failed.

To understand my second patch, and why it failed lets consider two
expressions, this Fortran expression:

  (gdb) ptype var8%ptr_2%t2_array	--<A>
  Operation: STRUCTOP_STRUCT		--(1)
   Operation: STRUCTOP_STRUCT		--(2)
    Operation: OP_VAR_VALUE		--(3)
     Symbol: var8
     Block: 0x3980ac0
    String: ptr_2
   String: t2_array

And this C expression:

  (gdb) ptype ptr && ptr->a == 3	--<B>
  Operation: BINOP_LOGICAL_AND		--(4)
   Operation: OP_VAR_VALUE		--(5)
    Symbol: ptr
    Block: 0x45a2a00
   Operation: BINOP_EQUAL		--(6)
    Operation: STRUCTOP_PTR		--(7)
     Operation: OP_VAR_VALUE		--(8)
      Symbol: ptr
      Block: 0x45a2a00
     String: a
    Operation: OP_LONG			--(9)
     Type: int
     Constant: 0x0000000000000003

In expression <A> we should assume that t2_array is of dynamic type.
Nothing has dynamic type in expression <B>.

This is how GDB currently handles expression <A>, in all cases,
EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation
always returns the real value of the symbol, this is not forced to a
zero value even in EVAL_AVOID_SIDE_EFFECTS mode.  This means that (3),
(5), and (8) will always return a real lazy value for the symbol.

However a STRUCTOP_STRUCT will always replace its result with a
non-lazy, zero value with the same type as its result.  So (2) will
lookup the field ptr_2 and create a zero value with that type.  In
this case the type is a pointer to a dynamic type.

Then, when we evaluate (1) to figure out the resolved type of
t2_array, we need to read the types dynamic properties.  These
properties are stored in memory relative to the objects base address,
and the base address is in var8%ptr_2, which we already figured out
has the value zero.  GDB then evaluates the DWARF expressions that
take the base address, add an offset and dereference.  GDB then ends
up trying to access addresses like 0x16, 0x8, etc.

To fix this, I proposed changing STRUCTOP_STRUCT so that instead of
returning a zero value we instead returned the actual value
representing the structure's field in the target.  My thinking was
that GDB would not try to access the value's contents unless it needed
it to resolve a dynamic type.  This belief was incorrect.

Consider expression <B>.  We already know that (5) and (8) will return
real values for the symbols being referenced.  The BINOP_LOGICAL_AND,
operation (4) will evaluate both of its children in
EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required
for C++ operator lookup.  This means that even if the value of (5)
would result in the BINOP_LOGICAL_AND returning false (say, ptr is
NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode.

Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS
mode, operation (9) is easy, it just returns a value with the constant
packed into it, but (7) is where the problem lies.  Currently in GDB
this STRUCTOP_STRUCT will always return a non-lazy zero value of the
correct type.

When the results of (7) and (9) are back in the BINOP_LOGICAL_AND
operation (6), the two values are passed to value_equal which performs
the comparison and returns a result.  Note, the two things compared
here are the immediate value (9), and a non-lazy zero value from (7).

However, with my proposed patch operation (7) no longer returns a zero
value, instead it returns a lazy value representing the actual value
in target memory.  When we call value_equal in (6) this code causes
GDB to try and fetch the actual value from target memory.  If `ptr` is
NULL then this will cause GDB to access some invalid address at an
offset from zero, this will most likely fail, and cause GDB to throw
an error instead of returning the expected type.

And so, we can now describe the problem that we're facing.  The way
GDB's expression evaluator is currently written we assume, when in
EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child
operation can safely have its content read without throwing an
error.  If child operations start returning real values (instead of
the fake zero values), then this is simply not true.

If we wanted to work around this then we would need to rewrite almost
all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode
does not cause evaluation of an operation to try and read the value of
a child operation.  As an example, consider this current GDB code from
eval.c:

  struct value *
  eval_op_equal (struct type *expect_type, struct expression *exp,
  	       enum noside noside, enum exp_opcode op,
  	       struct value *arg1, struct value *arg2)
  {
    if (binop_user_defined_p (op, arg1, arg2))
      {
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      }
    else
      {
        binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
        int tem = value_equal (arg1, arg2);
        struct type *type = language_bool_type (exp->language_defn,
  					      exp->gdbarch);
        return value_from_longest (type, (LONGEST) tem);
      }
  }

We could change this function to be this:

  struct value *
  eval_op_equal (struct type *expect_type, struct expression *exp,
  	       enum noside noside, enum exp_opcode op,
  	       struct value *arg1, struct value *arg2)
  {
    if (binop_user_defined_p (op, arg1, arg2))
      {
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      }
    else
      {
        struct type *type = language_bool_type (exp->language_defn,
  					      exp->gdbarch);
        if (noside == EVAL_AVOID_SIDE_EFFECTS)
  	  return value_zero (type, VALUE_LVAL (arg1));
        else
  	{
  	  binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
  	  int tem = value_equal (arg1, arg2);
  	  return value_from_longest (type, (LONGEST) tem);
  	}
      }
  }

Now we don't call value_equal unless we really need to.  However, we
would need to make the same, or similar change to almost all
operations, which would be a big task, and might not be a direction we
wanted to take GDB in.

So, for now, I'm proposing we go with the more targeted, Fortran
specific solution, that does the minimal required in order to
correctly resolve the dynamic types.

gdb/ChangeLog:

	* 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.

gdb/testsuite/ChangeLog:

	* gdb.fortran/dynamic-ptype-whatis.exp: New file.
	* gdb.fortran/dynamic-ptype-whatis.f90: New file.
---
 gdb/ChangeLog                                 |  16 ++
 gdb/f-exp.h                                   |  16 ++
 gdb/f-exp.y                                   |   9 +-
 gdb/f-lang.c                                  |  40 +++++
 gdb/testsuite/ChangeLog                       |   5 +
 .../gdb.fortran/dynamic-ptype-whatis.exp      | 158 ++++++++++++++++++
 .../gdb.fortran/dynamic-ptype-whatis.f90      |  93 +++++++++++
 7 files changed, 333 insertions(+), 4 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
 create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90

diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index b3d0e0e9d54..955d1873f51 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -273,6 +273,22 @@ class fortran_bound_2arg
   { 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 ce11b09b18e..6608831a9a5 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 0c49420e1f1..7e921b99517 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/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp
new file mode 100644
index 00000000000..d2ffd6d73f7
--- /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 00000000000..e56bf7952dc
--- /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
-- 
2.25.4