gcc-toolset-10-gdb/gdb-rhbz1905702-DWARF-data_location.patch

From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
From: Keith Seitz <keiths@redhat.com>
Date: Wed, 9 Dec 2020 16:47:07 -0500
Subject: gdb-rhbz1905702-DWARF-data_location.patch

;; Backport "fortran dynamic type related fixes"
;; Andrew Burgess (RH BZ 1905702)

commit e79eb02f2f09baecffb144bac6804f975065466f

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.

diff --git a/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.c b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.c
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.c
@@ -0,0 +1,63 @@
+/* Copyright 2014-2020 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   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/>.  */
+
+/* This C file simulates the implementation of object pointers in
+   GraalVM Java native images where the object data is not addressed
+   directly. It serves as a regression test for a bug where printing
+   of such redirected data structures suffers from a gdb exception.
+
+   Debugging information on how to decode an object pointer to
+   identify the address of the underlying data will be generated
+   separately by the testcase using that file. */
+
+#include <stdlib.h>
+#include <string.h>
+
+struct Object {
+  struct Object *next;
+  int val;
+};
+
+struct Object *testOop;
+
+extern int debugMe() {
+  return 0;
+}
+
+struct Object *newObject() {
+  char *bytes = malloc(sizeof(struct Object));
+  return (struct Object *)bytes;
+}
+
+int
+main (void)
+{
+  struct Object *obj1 = newObject();
+  struct Object *obj2 = newObject();
+  struct Object *obj3 = newObject();
+  obj1->val = 0;
+  obj2->val = 1;
+  obj3->val = 2;
+
+  obj1->next = obj2;
+  obj2->next = obj3;
+  obj3->next = obj1;
+
+  testOop = obj1;
+
+  return debugMe();
+}
diff --git a/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.exp b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.exp
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.exp
@@ -0,0 +1,122 @@
+# Copyright 2014-2020 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/>.
+load_lib dwarf.exp
+
+# This test can only be run on targets which support DWARF-2 and use gas.
+if {![dwarf2_support]} {
+    return 0
+}
+
+standard_testfile .c -dw.S
+
+if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
+    return -1
+}
+
+# Make some DWARF for the test.
+set asm_file [standard_output_file $srcfile2]
+Dwarf::assemble $asm_file {
+    
+    cu {} {
+ 	DW_TAG_compile_unit {
+                {DW_AT_language @DW_LANG_C99}
+                {DW_AT_name     data-loc2.c}
+                {DW_AT_comp_dir /tmp}
+        } {
+            declare_labels integer_label struct_label pointer_label
+
+            integer_label: DW_TAG_base_type {
+                {DW_AT_byte_size 4 DW_FORM_sdata}
+                {DW_AT_encoding  @DW_ATE_signed}
+                {DW_AT_name      integer}
+            }
+
+	    struct_label: DW_TAG_structure_type {
+		{DW_AT_name "Object"}
+		{DW_AT_byte_size 20 DW_FORM_sdata}
+                {DW_AT_data_location {
+                    DW_OP_push_object_address
+                } SPECIAL_expr}
+	    } {
+		member {
+		    {name next}
+		    {type :$pointer_label}
+		    {data_member_location 0 data1}
+		}
+		member {
+		    {name val}
+		    {type :$integer_label}
+		    {data_member_location 8 data1}
+		}
+	    }
+	    pointer_label: DW_TAG_pointer_type {
+		{DW_AT_byte_size 4 DW_FORM_sdata}
+		{DW_AT_type  :$struct_label}
+	    }
+            DW_TAG_variable {
+                {DW_AT_name testOop}
+                {DW_AT_type :$pointer_label}
+                {DW_AT_location {
+                    DW_OP_addr [gdb_target_symbol testOop]
+                } SPECIAL_expr}
+                {external 1 flag}
+            }
+	}
+    }
+}
+
+# Now that we've generated the DWARF debugging info, rebuild our
+# program using our debug info instead of the info generated by
+# the compiler.
+
+if { [prepare_for_testing "failed to prepare" ${testfile} \
+	  [list $srcfile $asm_file] {nodebug}] } {
+    return -1
+}
+
+if ![runto_main] {
+    return -1
+}
+
+# ensure the object network is set up as expected and check that
+# printing of structs which employ the data_location does not
+# fail with a gdb exception
+
+gdb_test "break debugMe" \
+         "Breakpoint .*" \
+         "set breakpoint at debugMe"
+
+gdb_continue_to_breakpoint "continue to debugMe"
+
+gdb_test "print testOop->val" \
+         ".* = 0"
+
+gdb_test "print testOop->next->val" \
+         ".* = 1"
+
+gdb_test "print testOop->next->next->val" \
+         ".* = 2"
+
+gdb_test "print *testOop" \
+    ".* = {next = .*, val = 0}" \
+    "print contents of struct"
+
+gdb_test "print *testOop->next" \
+    ".* = {next = .*, val = 1}" \
+    "print contents of an indirect struct"
+
+gdb_test "print *testOop->next->next" \
+    ".* = {next = .*, val = 2}" \
+    "print contents of a double indirect struct"
diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
@@ -0,0 +1,43 @@
+# Copyright 2020 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 that GDB can print an allocatable array that is a data field
+# within a class like type.
+
+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 {![runto MAIN__]} {
+    untested main"could not run to main"
+    return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "Break Here"
+
+# If this first test fails then the Fortran compiler being used uses
+# different names, or maybe a completely different approach, for
+# representing class like structures.  The following tests are
+# cetainly going to fail.
+gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)"
+gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+"
+gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)"
diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90
@@ -0,0 +1,54 @@
+! Copyright 2020 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/>.
+
+module test_module
+  type test_type
+     integer a
+     real, allocatable :: b (:, :)
+   contains
+     procedure :: test_proc
+  end type test_type
+
+contains
+
+  subroutine test_proc (this)
+    class(test_type), intent (inout) :: this
+    allocate (this%b (3, 2))
+    call fill_array_2d (this%b)
+    print *, ""		! Break Here
+  contains
+    ! Helper subroutine to fill 2-dimensional array with unique
+    ! values.
+    subroutine fill_array_2d (array)
+      real, dimension (:,:) :: array
+      real :: counter
+
+      counter = 1.0
+      do i=LBOUND (array, 2), UBOUND (array, 2), 1
+         do j=LBOUND (array, 1), UBOUND (array, 1), 1
+            array (j,i) = counter
+            counter = counter + 1
+         end do
+      end do
+    end subroutine fill_array_2d
+  end subroutine test_proc
+end module
+
+program test
+  use test_module
+  implicit none
+  type(test_type) :: t
+  call t%test_proc ()
+end program test
diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
@@ -0,0 +1,46 @@
+# Copyright 2020 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 for GDB printing a pointer to a type containing a buffer.
+
+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 {![runto MAIN__]} {
+    untested "could not run to main"
+    return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "Break Here"
+
+gdb_test "print *buffer" \
+    " = \\( alpha = \\(1\\.5, 2\\.5, 3\\.5, 4\\.5, 5\\.5\\) \\)"
+
+set l_buffer_type [multi_line \
+		       "Type l_buffer" \
+		       "    real\\(kind=4\\) :: alpha\\(.\\)" \
+		       "End Type l_buffer" ]
+
+gdb_test "ptype buffer" "type = PTR TO -> \\( ${l_buffer_type} \\)"
+gdb_test "ptype *buffer" "type = ${l_buffer_type}"
+gdb_test "ptype buffer%alpha" "type = real\\(kind=4\\) \\(5\\)"
diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90 b/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
@@ -0,0 +1,34 @@
+! Copyright 2020 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 allocate_array
+
+  type l_buffer
+     real, dimension(:), pointer :: alpha
+  end type l_buffer
+  type(l_buffer), pointer :: buffer
+
+  allocate (buffer)
+  allocate (buffer%alpha (5))
+
+  buffer%alpha (1) = 1.5
+  buffer%alpha (2) = 2.5
+  buffer%alpha (3) = 3.5
+  buffer%alpha (4) = 4.5
+  buffer%alpha (5) = 5.5
+
+  print *, buffer%alpha	! Break Here.
+
+end program allocate_array
diff --git a/gdb/valops.c b/gdb/valops.c
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1553,38 +1553,28 @@ value_ind (struct value *arg1)
   if (TYPE_CODE (base_type) == TYPE_CODE_PTR)
     {
       struct type *enc_type;
-      CORE_ADDR addr;
-
-      if (type_not_associated (base_type))
-        error (_("Attempt to take contents of a not associated pointer."));
-
-      if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type)))
-	addr = value_address (arg1);
-      else
-	addr = value_as_address (arg1);
-
-      if (addr != 0)
-	TYPE_TARGET_TYPE (base_type) =
-	    resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), NULL, addr);
 
       /* We may be pointing to something embedded in a larger object.
          Get the real type of the enclosing object.  */
       enc_type = check_typedef (value_enclosing_type (arg1));
       enc_type = TYPE_TARGET_TYPE (enc_type);
 
+      CORE_ADDR base_addr;
       if (TYPE_CODE (check_typedef (enc_type)) == TYPE_CODE_FUNC
 	  || TYPE_CODE (check_typedef (enc_type)) == 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));
+	base_addr = find_function_addr (arg1, NULL);
       else
-	/* Retrieve the enclosing object pointed to.  */
-	arg2 = value_at_lazy (enc_type, 
-			      (addr - 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."));
diff --git a/gdb/value.c b/gdb/value.c
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -3630,10 +3630,19 @@ coerce_ref_if_computed (const struct value *arg)
 struct value *
 readjust_indirect_value_type (struct value *value, struct type *enc_type,
 			      const struct type *original_type,
-			      const struct value *original_value)
+			      struct value *original_value,
+			      CORE_ADDR original_value_address)
 {
+  gdb_assert (TYPE_CODE (original_type) == TYPE_CODE_PTR
+	      || TYPE_IS_REFERENCE (original_type));
+
+  struct type *original_target_type = TYPE_TARGET_TYPE (original_type);
+  struct type *resolved_original_target_type
+    = resolve_dynamic_type (original_target_type, NULL,
+			    original_value_address);
+
   /* Re-adjust type.  */
-  deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
+  deprecated_set_value_type (value, resolved_original_target_type);
 
   /* Add embedding info.  */
   set_value_enclosing_type (value, enc_type);
@@ -3660,12 +3669,11 @@ coerce_ref (struct value *arg)
   enc_type = check_typedef (value_enclosing_type (arg));
   enc_type = TYPE_TARGET_TYPE (enc_type);
 
-  retval = value_at_lazy (enc_type,
-                          unpack_pointer (value_type (arg),
-                                          value_contents (arg)));
+  CORE_ADDR addr = unpack_pointer (value_type (arg), value_contents (arg));
+  retval = value_at_lazy (enc_type, addr);
   enc_type = value_type (retval);
-  return readjust_indirect_value_type (retval, enc_type,
-                                       value_type_arg_tmp, arg);
+  return readjust_indirect_value_type (retval, enc_type, value_type_arg_tmp,
+				       arg, addr);
 }
 
 struct value *
diff --git a/gdb/value.h b/gdb/value.h
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -488,7 +488,9 @@ extern struct value *coerce_ref_if_computed (const struct value *arg);
 
 /* Setup a new value type and enclosing value type for dereferenced value VALUE.
    ENC_TYPE is the new enclosing type that should be set.  ORIGINAL_TYPE and
-   ORIGINAL_VAL are the type and value of the original reference or pointer.
+   ORIGINAL_VAL are the type and value of the original reference or
+   pointer.  ORIGINAL_VALUE_ADDRESS is the address within VALUE, that is
+   the address that was dereferenced.
 
    Note, that VALUE is modified by this function.
 
@@ -497,7 +499,8 @@ extern struct value *coerce_ref_if_computed (const struct value *arg);
 extern struct value * readjust_indirect_value_type (struct value *value,
 						    struct type *enc_type,
 						    const struct type *original_type,
-						    const struct value *original_val);
+						    struct value *original_val,
+						    CORE_ADDR original_value_address);
 
 /* Convert a REF to the object referenced.  */