From e79eb02f2f09baecffb144bac6804f975065466f Mon Sep 17 00:00:00 2001
From: Andrew Burgess <andrew.burgess@embecosm.com>
Date: Thu, 9 Jul 2020 16:26:23 +0100
Subject: gdb/fortran: resolve dynamic types when readjusting after an
 indirection

After dereferencing a pointer (in value_ind) or following a
reference (in coerce_ref) we call readjust_indirect_value_type to
"fixup" the type of the resulting value object.

This fixup handles cases relating to the type of the resulting object
being different (a sub-class) of the original pointers target type.

If we encounter a pointer to a dynamic type then after dereferencing a
pointer (in value_ind) the type of the object created will have had
its dynamic type resolved.  However, in readjust_indirect_value_type,
we use the target type of the original pointer to "fixup" the type of
the resulting value.  In this case, the target type will be a dynamic
type, so the resulting value object, once again has a dynamic type.

This then triggers an assertion later within GDB.

The solution I propose here is that we call resolve_dynamic_type on
the pointer's target type (within readjust_indirect_value_type) so
that the resulting value is not converted back to a dynamic type.

The test case is based on the original test in the bug report.

gdb/ChangeLog:

	PR fortran/23051
	PR fortran/26139
	* valops.c (value_ind): Pass address to
	readjust_indirect_value_type.
	* value.c (readjust_indirect_value_type): Make parameter
	non-const, and add extra address parameter.  Resolve original type
	before using it.
	* value.h (readjust_indirect_value_type): Update function
	signature and comment.

gdb/testsuite/ChangeLog:

	PR fortran/23051
	PR fortran/26139
	* gdb.fortran/class-allocatable-array.exp: New file.
	* gdb.fortran/class-allocatable-array.f90: New file.
	* gdb.fortran/pointer-to-pointer.exp: New file.
	* gdb.fortran/pointer-to-pointer.f90: New file.
---
 gdb/valops.c | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

(limited to 'gdb/valops.c')

diff --git a/gdb/valops.c b/gdb/valops.c
index 033fd42..0eb2b09 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1559,20 +1559,24 @@ value_ind (struct value *arg1)
       enc_type = check_typedef (value_enclosing_type (arg1));
       enc_type = TYPE_TARGET_TYPE (enc_type);
 
+      CORE_ADDR base_addr;
       if (check_typedef (enc_type)->code () == TYPE_CODE_FUNC
 	  || check_typedef (enc_type)->code () == TYPE_CODE_METHOD)
-	/* For functions, go through find_function_addr, which knows
-	   how to handle function descriptors.  */
-	arg2 = value_at_lazy (enc_type, 
-			      find_function_addr (arg1, NULL));
+	{
+	  /* For functions, go through find_function_addr, which knows
+	     how to handle function descriptors.  */
+	  base_addr = find_function_addr (arg1, NULL);
+	}
       else
-	/* Retrieve the enclosing object pointed to.  */
-	arg2 = value_at_lazy (enc_type, 
-			      (value_as_address (arg1)
-			       - value_pointed_to_offset (arg1)));
-
+	{
+	  /* Retrieve the enclosing object pointed to.  */
+	  base_addr = (value_as_address (arg1)
+		       - value_pointed_to_offset (arg1));
+	}
+      arg2 = value_at_lazy (enc_type, base_addr);
       enc_type = value_type (arg2);
-      return readjust_indirect_value_type (arg2, enc_type, base_type, arg1);
+      return readjust_indirect_value_type (arg2, enc_type, base_type,
+					   arg1, base_addr);
     }
 
   error (_("Attempt to take contents of a non-pointer value."));
-- 
cgit v1.1