[PATCH v2 0/4] Dynamic properties of pointers

[PATCH v2 0/4] Dynamic properties of pointers

[Nils-Christian Kempke]

Hi!

Please find attached v2 of this series.  The main change is patch 3
which became a 'some compiler DWARF that is wrong but we still want to
support it' patch after a discussion in
https://sourceware.org/pipermail/gdb-patches/2022-September/192159.html
and thanks to Simon and Zoran.  They convinced me that my v1 was wrong.

V1 can be found here:

https://sourceware.org/pipermail/gdb-patches/2022-September/191934.html

Changes since v1:

  * Patch 1 is unchanged and was already approved by Simon in v1.

  * Patch 2:
  Patch 2 changed quite a bit ang mainly got simpler.  Initially I
  thought here that DW_TAG_pointer_type could actually have the
  DW_AT_associated attribute, but it turned out that this again was an
  icc/icpc/ifort DWARF peculiarity.  The part handling this attribute
  for dynamic pointer types got moved to patch 3.  As a result, I could
  use the same handling for resolving dynamic pointers and references
  in resolve_dynamic_type_internal which made the patch simpler.
  I fixed the Simons' leftover comments in
  https://sourceware.org/pipermail/gdb-patches/2022-September/192142.html

  * Patch 3:
  From patch 2 the DW_AT_associated handling moved to this patch.
  Additionally, I wrapped all changed in this patch in compiler guards
  checking for icc/icpc/ifort and added a dwarf2 tests more concretely
  describing the poor Intel classic compiler DWARF we want to support
  here.  Last, I rewrote the commit message and added some comments.

  * Patch 4: Added a comment to the loop in the testcase.

I am not sure whether I did patch 3 the 'normal/usual' way compiler
quirks are implemented in GDB.  Have a look!  I'm looking forward to
comments.

Cheers!
Nils

Bernhard Heckel (1):
  gdb/types: Resolve pointer types dynamically

Nils-Christian Kempke (3):
  gdb, testsuite: handle icc and icpc deprecated remarks
  gdb, typeprint: workaround icc/icpc/ifort pointer/reference DWARF
  gdb/fortran: Fix sizeof intrinsic for Fortran

 gdb/eval.c                                    |   3 +
 gdb/gdbtypes.c                                |  86 ++++++++-
 gdb/gdbtypes.h                                |   5 +
 gdb/testsuite/gdb.cp/vla-cxx.cc               |   4 +
 gdb/testsuite/gdb.cp/vla-cxx.exp              |  31 ++++
 gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp       |  16 +-
 .../icc-ifort-pointers-and-references.c       |  37 ++++
 .../icc-ifort-pointers-and-references.exp     | 150 +++++++++++++++
 .../gdb.fortran/pointer-to-pointer.exp        |   2 +-
 gdb/testsuite/gdb.fortran/pointers.exp        | 172 ++++++++++++++++++
 gdb/testsuite/gdb.fortran/pointers.f90        |  29 +++
 gdb/testsuite/gdb.fortran/sizeof.exp          | 115 ++++++++++++
 gdb/testsuite/gdb.fortran/sizeof.f90          | 108 +++++++++++
 gdb/testsuite/lib/gdb.exp                     |  18 ++
 gdb/valprint.c                                |  40 +++-
 15 files changed, 796 insertions(+), 20 deletions(-)
 create mode 100644 gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.exp
 create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
 create mode 100644 gdb/testsuite/gdb.fortran/sizeof.exp
 create mode 100644 gdb/testsuite/gdb.fortran/sizeof.f90

-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v2 1/4] gdb, testsuite: handle icc and icpc deprecated remarks

[Nils-Christian Kempke]

Starting with icc/icpc version 2021.7.0 and higher both compilers emit a
deprecation remark when used.  E.g.

  >> icc --version
  icc: remark #10441: The Intel(R) C++ Compiler Classic (ICC) is
  deprecated and will be removed from product release in the second half
  of 2023. The Intel(R) oneAPI DPC++/C++ Compiler (ICX) is the recommended
  compiler moving forward. Please transition to use this compiler. Use
  '-diag-disable=10441' to disable this message.
  icc (ICC) 2021.7.0 20220713
  Copyright (C) 1985-2022 Intel Corporation.  All rights reserved.

  >> icpc --version
  icpc: remark #10441: The Intel(R) C++ Compiler Classic (ICC) is
  deprecated ...
  icpc (ICC) 2021.7.0 20220720
  Copyright (C) 1985-2022 Intel Corporation.  All rights reserved.

As the testsuite compile fails when unexpected output by the compiler is
seen this change in the compiler breaks all existing icc and icpc tests.
This patch makes the gdb testsuite more forgiving by a) allowing the
output of the remark when trying to figure out the compiler version
and by b) adding '-diag-disable=10441' to the compile command whenever
gdb_compile is called without the intention to detect the compiler.

gdb/testsuite/ChangeLog:
2022-07-20  Nils-Christian Kempke  <nils-christian.kempke@intel.com>

	* lib/gdb.exp: Handle icc/icpc deprecation warnings.

Signed-off-by: Nils-Christian Kempke <nils-christian.kempke@intel.com>
---
 gdb/testsuite/lib/gdb.exp | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 432ed5e34ca..a6538fcab9c 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -4493,6 +4493,13 @@ proc gdb_compile {source dest type options} {
 	}
     }
 
+    # Starting with 2021.7.0 (recognized as icc-20-21-7 by GDB) icc and icpc
+    # are marked as deprecated and both compilers emit the remark #10441.  To
+    # let GDB still compile successfully, we disable these warnings here.
+    if {!$getting_compiler_info && [test_compiler_info {icc-20-21-[7-9]}]} {
+	lappend new_options "additional_flags=-diag-disable=10441"
+    }
+
     # Treating .c input files as C++ is deprecated in Clang, so
     # explicitly force C++ language.
     if { !$getting_compiler_info
@@ -4749,6 +4756,17 @@ proc gdb_compile {source dest type options} {
     # Prune uninteresting compiler (and linker) output.
     regsub "Creating library file: \[^\r\n\]*\[\r\n\]+" $result "" result
 
+    # Starting with 2021.7.0 icc and icpc are marked as deprecated and both
+    # compilers emit a remark #10441.  To let GDB still compile successfully,
+    # we disable these warnings.  When $getting_compiler_info is true however,
+    # we do not yet know the compiler (nor its version) and instead prune these
+    # lines from the compiler output to let the get_compiler_info pass.
+    if {$getting_compiler_info} {
+	regsub \
+	    "(icc|icpc): remark #10441: The Intel\\(R\\) C\\+\\+ Compiler Classic \\(ICC\\) is deprecated\[^\r\n\]*" \
+	    "$result" "" result
+    }
+
     regsub "\[\r\n\]*$" "$result" "" result
     regsub "^\[\r\n\]*" "$result" "" result
     
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v2 2/4] gdb/types: Resolve pointer types dynamically

[Nils-Christian Kempke]

From: Bernhard Heckel <bernhard.heckel@intel.com>

This commit allows pointers to be dynamic types (on the outmost
level).  Similar to references, a pointer is considered a dynamic type
if its target type is a dynamic type and it is on the outmost level.

The pointer resolution follows the one of references.

This generally makes the GDB output more verbose.  We are able to print
more details about a pointer's target like the dimension of an array.

In Fortran, if we have a pointer to a dynamic type

  type buffer
    real, dimension(:), pointer :: ptr
  end type buffer
  type(buffer), pointer :: buffer_ptr
  allocate (buffer_ptr)
  allocate (buffer_ptr%ptr (5))

which then gets allocated, we now resolve the dynamic type before
printing the pointer's type:

Before:

  (gdb) ptype buffer_ptr
  type = PTR TO -> ( Type buffer
    real(kind=4) :: alpha(:)
  End Type buffer )

After:

  (gdb) ptype buffer_ptr
  type = PTR TO -> ( Type buffer
    real(kind=4) :: alpha(5)
  End Type buffer )

Similarly in C++ we can dynamically resolve e.g. pointers to arrays:

  int len = 3;
  int arr[len];
  int (*ptr)[len];
  int ptr = &arr;

Once the pointer is assigned one gets:

Before:

  (gdb) p ptr
  $1 = (int (*)[variable length]) 0x123456
  (gdb) ptype ptr
  type = int (*)[variable length]

After:

  (gdb) p ptr
  $1 = (int (*)[3]) 0x123456
  (gdb) ptype ptr
  type = int (*)[3]

For more examples see the modified/added test cases.
---
 gdb/gdbtypes.c                                |  16 ++-
 gdb/testsuite/gdb.cp/vla-cxx.cc               |   4 +
 gdb/testsuite/gdb.cp/vla-cxx.exp              |  15 +++
 gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp       |  16 +--
 .../gdb.fortran/pointer-to-pointer.exp        |   2 +-
 gdb/testsuite/gdb.fortran/pointers.exp        | 114 ++++++++++++++++++
 gdb/testsuite/gdb.fortran/pointers.f90        |  29 +++++
 gdb/valprint.c                                |   6 -
 8 files changed, 182 insertions(+), 20 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 643bb0a14a3..5eb4b649d5c 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2085,8 +2085,10 @@ is_dynamic_type_internal (struct type *type, int top_level)
 {
   type = check_typedef (type);
 
-  /* We only want to recognize references at the outermost level.  */
-  if (top_level && type->code () == TYPE_CODE_REF)
+  /* We only want to recognize references and pointers at the outermost
+     level.  */
+  if (top_level
+      && (type->code () == TYPE_CODE_REF || type->code () == TYPE_CODE_PTR))
     type = check_typedef (type->target_type ());
 
   /* Types that have a dynamic TYPE_DATA_LOCATION are considered
@@ -2825,6 +2827,7 @@ resolve_dynamic_type_internal (struct type *type,
       switch (type->code ())
 	{
 	case TYPE_CODE_REF:
+	case TYPE_CODE_PTR:
 	  {
 	    struct property_addr_info pinfo;
 
@@ -2838,9 +2841,12 @@ resolve_dynamic_type_internal (struct type *type,
 	    pinfo.next = addr_stack;
 
 	    resolved_type = copy_type (type);
-	    resolved_type->set_target_type
-	      (resolve_dynamic_type_internal (type->target_type (),
-					      &pinfo, top_level));
+
+	    /* For pointers the target address might not be set yet.  */
+	    if (pinfo.addr != 0)
+	      resolved_type->set_target_type
+		(resolve_dynamic_type_internal (type->target_type (),
+						&pinfo, top_level));
 	    break;
 	  }
 
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
index 9795f8cc39b..c03d1a80ac8 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.cc
+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
@@ -40,6 +40,10 @@ int main(int argc, char **argv)
   typedef typeof (vla) &vlareftypedef;
   vlareftypedef vlaref2 (vla);
   container c;
+  typeof (vla) *ptr = nullptr;
+
+  // Before pointer assignment
+  ptr = &vla;
 
   for (int i = 0; i < z; ++i)
     vla[i] = 5 + 2 * i;
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index 3494b5e8b77..bb94bce4e6a 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -23,6 +23,18 @@ if ![runto_main] {
     return -1
 }
 
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+
+gdb_test "ptype ptr" "= int \\(\\*\\)\\\[variable length\\\]" \
+    "ptype ptr, Before pointer assignment"
+
+gdb_test "print ptr" "= \\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" \
+    "print ptr, Before pointer assignment"
+
+gdb_test "print *ptr" "Cannot access memory at address 0x0" \
+    "print *ptr, Before pointer assignment"
+
 gdb_breakpoint [gdb_get_line_number "vlas_filled"]
 gdb_continue_to_breakpoint "vlas_filled"
 
@@ -33,3 +45,6 @@ gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
 # bug being tested, it's better not to depend on the exact spelling.
 gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}"
 gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}"
+gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]"
+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex"
+gdb_test "print *ptr" " = \\{5, 7, 9\\}"
diff --git a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp
index 83a5fccd831..7c7cf12c4eb 100644
--- a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp
+++ b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp
@@ -156,7 +156,7 @@ gdb_test "print foo.three_ptr.all'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(1 \\.\\. 3\\) of integer"
 
 # foo.three_ptr
 
@@ -179,7 +179,7 @@ gdb_test "print foo.three_ptr'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(1 \\.\\. 3\\) of integer"
 
 # foo.three_ptr_tdef.all
 
@@ -205,7 +205,7 @@ gdb_test "print foo.three_ptr_tdef.all'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr_tdef.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(1 \\.\\. 3\\) of integer"
 
 # foo.three_ptr_tdef
 
@@ -228,7 +228,7 @@ gdb_test "print foo.three_ptr_tdef'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr_tdef" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(1 \\.\\. 3\\) of integer"
 
 # foo.five_ptr.all
 
@@ -260,7 +260,7 @@ gdb_test "print foo.five_ptr.all'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(2 \\.\\. 6\\) of integer"
 
 # foo.five_ptr
 
@@ -289,7 +289,7 @@ gdb_test "print foo.five_ptr'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(2 \\.\\. 6\\) of integer"
 
 # foo.five_ptr_tdef.all
 
@@ -321,7 +321,7 @@ gdb_test "print foo.five_ptr_tdef.all'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr_tdef.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(2 \\.\\. 6\\) of integer"
 
 # foo.five_ptr_tdef
 
@@ -350,4 +350,4 @@ gdb_test "print foo.five_ptr_tdef'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr_tdef" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(2 \\.\\. 6\\) of integer"
diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
index 8c43d177295..fcaa4bc9708 100644
--- a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
+++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
@@ -41,7 +41,7 @@ gdb_test "print buffer" \
 gdb_test "ptype buffer" \
     [multi_line \
 	 "type = PTR TO -> \\( Type l_buffer" \
-	 "    $real4 :: alpha\\(:\\)" \
+	 "    $real4 :: alpha\\(5\\)" \
 	 "End Type l_buffer \\)" ]
 gdb_test "ptype buffer%alpha" "type = $real4 \\(5\\)"
 
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
new file mode 100644
index 00000000000..c7a60fec6b6
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,114 @@
+# Copyright 2022 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "pointers.f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}]} {
+    return -1
+}
+
+if {![fortran_runto_main]} {
+    untested "could not run to main"
+    return -1
+}
+
+# Depending on the compiler being used, the type names can be printed differently.
+set logical [fortran_logical4]
+set real [fortran_real4]
+set int [fortran_int4]
+set complex [fortran_complex4]
+
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) 0x0" \
+    "print logp, not associated"
+gdb_test "print *logp" "Cannot access memory at address 0x0" \
+    "print *logp, not associated"
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) 0x0" \
+    "print comp, not associated"
+gdb_test "print *comp" "Cannot access memory at address 0x0" \
+    "print *comp, not associated"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) 0x0" \
+    "print charp, not associated"
+gdb_test "print *charp" "Cannot access memory at address 0x0" \
+    "print *charp, not associated"
+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) 0x0" \
+    "print charap, not associated"
+gdb_test "print *charap" "Cannot access memory at address 0x0" \
+    "print *charap, not associated"
+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" \
+    "print intp, not associated"
+gdb_test "print *intp" "Cannot access memory at address 0x0" \
+    "print *intp, not associated"
+gdb_test "print intap" " = <not associated>" "print intap, not associated"
+gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" \
+    "print realp, not associated"
+gdb_test "print *realp" "Cannot access memory at address 0x0" \
+    "print *realp, not associated"
+gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
+gdb_test "print cyclicp1" "= \\( i = -?\\d+, p = 0x0 \\)" \
+    "print cyclicp1, not associated"
+gdb_test "print cyclicp1%p" \
+    "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0" \
+    "print cyclicp1%p, not associated"
+
+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
+gdb_continue_to_breakpoint "Before value assignment"
+gdb_test "print *(twop)%ivla2" "= <not allocated>"
+
+gdb_breakpoint [gdb_get_line_number "After value assignment"]
+gdb_continue_to_breakpoint "After value assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?"
+gdb_test "print *logp" "= \\.TRUE\\."
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?"
+gdb_test "print *comp" "= \\(1,2\\)"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?"
+gdb_test "print *charp" "= 'a'"
+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?"
+gdb_test "print *charap" "= 'abc'"
+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?"
+gdb_test "print *intp" "= 10"
+gdb_test "print intap" "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)" \
+    "print intap, associated"
+gdb_test "print intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)" \
+    "print intvlap, associated"
+gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?"
+gdb_test "print *realp" "= 3\\.14000\\d+"
+gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
+gdb_test "print *(arrayOfPtr(2)%p)" \
+    "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\(211, 221\\) \\(212, 222\\)\\) \\)"
+gdb_test "print arrayOfPtr(3)%p" "= \\(PTR TO -> \\( Type two \\)\\) 0x0" \
+    "print arrayOfPtr(3)%p"
+
+gdb_test_multiple "print *(arrayOfPtr(3)%p)" \
+    "print *(arrayOfPtr(3)%p), associated" {
+    # gfortran
+    -re -wrap "Cannot access memory at address 0x0" {
+	pass $gdb_test_name
+    }
+    # ifx
+    -re -wrap "Location address is not set." {
+	pass $gdb_test_name
+    }
+}
+
+gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)"
+gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer \\)\\) $hex\( <.*>\)?"
+gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
+gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla"
+gdb_test "print \$pc" "\\(PTR TO -> \\( void \\(\\) \\(\\) \\)\\) $hex <pointers\\+\\d+>" \
+    "Print program counter"
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
index 7f628662546..e480bdc7fbb 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,14 +20,26 @@ program pointers
     integer, allocatable :: ivla2 (:, :)
   end type two
 
+  type :: typeWithPointer
+    integer i
+    type(typeWithPointer), pointer:: p
+  end type typeWithPointer
+
+  type :: twoPtr
+    type (two), pointer :: p
+  end type twoPtr
+
   logical, target :: logv
   complex, target :: comv
   character, target :: charv
   character (len=3), target :: chara
   integer, target :: intv
   integer, target, dimension (10,2) :: inta
+  integer, target, allocatable, dimension (:) :: intvla
   real, target :: realv
   type(two), target :: twov
+  type(twoPtr) :: arrayOfPtr (3)
+  type(typeWithPointer), target:: cyclicp1,cyclicp2
 
   logical, pointer :: logp
   complex, pointer :: comp
@@ -35,6 +47,7 @@ program pointers
   character (len=3), pointer :: charap
   integer, pointer :: intp
   integer, pointer, dimension (:,:) :: intap
+  integer, pointer, dimension (:) :: intvlap
   real, pointer :: realp
   type(two), pointer :: twop
 
@@ -44,8 +57,14 @@ program pointers
   nullify (charap)
   nullify (intp)
   nullify (intap)
+  nullify (intvlap)
   nullify (realp)
   nullify (twop)
+  nullify (arrayOfPtr(1)%p)
+  nullify (arrayOfPtr(2)%p)
+  nullify (arrayOfPtr(3)%p)
+  nullify (cyclicp1%p)
+  nullify (cyclicp2%p)
 
   logp => logv    ! Before pointer assignment
   comp => comv
@@ -53,8 +72,14 @@ program pointers
   charap => chara
   intp => intv
   intap => inta
+  intvlap => intvla
   realp => realv
   twop => twov
+  arrayOfPtr(2)%p => twov
+  cyclicp1%i = 1
+  cyclicp1%p => cyclicp2
+  cyclicp2%i = 2
+  cyclicp2%p => cyclicp1
 
   logv = associated(logp)     ! Before value assignment
   comv = cmplx(1,2)
@@ -63,6 +88,10 @@ program pointers
   intv = 10
   inta(:,:) = 1
   inta(3,1) = 3
+  allocate (intvla(10))
+  intvla(:) = 2
+  intvla(4) = 4
+  intvlap => intvla
   realv = 3.14
 
   allocate (twov%ivla1(3))
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 91a59419c4e..258885b4471 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1137,12 +1137,6 @@ value_check_printable (struct value *val, struct ui_file *stream,
       return 0;
     }
 
-  if (type_not_associated (value_type (val)))
-    {
-      val_print_not_associated (stream);
-      return 0;
-    }
-
   if (type_not_allocated (value_type (val)))
     {
       val_print_not_allocated (stream);
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v2 3/4] gdb, typeprint: workaround icc/icpc/ifort pointer/reference DWARF

[Nils-Christian Kempke]

Intel classic compilers (icc/icpc/ifort) for references/pointers
to arrays generate DWARF that looks like

 <2><17d>: Abbrev Number: 22 (DW_TAG_variable)
    <17e>   DW_AT_decl_line   : 41
    <17f>   DW_AT_decl_file   : 1
    <180>   DW_AT_name        : (indirect string, offset: 0x1f1): vlaref
    <184>   DW_AT_type        : <0x214>
    <188>   DW_AT_location    : 2 byte block: 76 50
      (DW_OP_breg6 (rbp): -48)
 ...
 <1><214>: Abbrev Number: 12 (DW_TAG_reference/pointer_type)
    <215>   DW_AT_type        : <0x219>
    <216>   DW_AT_associated  : ...     <- for Fortran pointers
 <1><219>: Abbrev Number: 27 (DW_TAG_array_type)
    <21a>   DW_AT_type        : <0x10e>
    <21e>   DW_AT_data_location: 2 byte block: 97 6
      (DW_OP_push_object_address; DW_OP_deref)
 <2><221>: Abbrev Number: 28 (DW_TAG_subrange_type)
    <222>   DW_AT_upper_bound : <0x154>
 <2><226>: Abbrev Number: 0

This is, to my knowledge, somewhat allowed and corrcet DWARF, however,
there are 2 issues with the emitted DWARF.

First, the DW_AT_associated that is emmited (only for Fortran pointers) is
not supposed to be emitted with pointer types.  Rather, the tag is expected
on types that have the 'pointer property'.  In Fortran a pointer is more
than just an address - it is a fully selfcontained type that can be
associated with any object of the same type that has the target/pointer
property.
As such, it will have fields for, e.g., the rank of its underlying array.
The pointer property is normally implicitly modelled in DWARF by
emitting, e.g., a DW_TAG_array_type and giving it a DW_AT_associated
property.  This automatically makes it a Fortran pointer-to-array type
and is also the way gfortran/ifx model their Fortran pointers in DWARF.
Intel classic compilers deviated from this way of modeling Fortran
pointers.

Second, the above DWARF assumes that the address needed to resolve the
DW_OP_push_object_address is the address of the original variable, not
the address of the array itself.  This seems incorrect as when resolving
the array, the address of the object currently being evaluated is the
one of the array, not the one of the pointer.  This lets GDB fail when
tyring to resolve the arrays underlying the above pointer/reference
construct, as GDB assumes that the address of the array is needed
instead.

While this DWARF is wrong, icc/icpc/ifort will likely not change their
DWARF anymore as they are slowly being EOLed.  Additionally, any older
versions of the compilers will anyway not work with GDB.  This patch
implements a workaround that makes GDB work with the Intel classic
compiler's DWARF.  It adds workarounds guarded by compiler checks.
Whenever resolving a dynamic type that is a pointer/reference we check
whether the type's producer has been an Intel classic compiler (by checking
the types objfile and all producers in this objfile) and, if this is the
case, we take the presence of the DW_AT_data_location in the
pointer's/reference's target_type () as an indication that we need to use
the pointer's address rather than its target address to resolve the
target_type ().

Additionally, we resolve the DW_AT_associated property on pointers when
their producer is an Intel classic compiler.

Without the above patch GDB would usually display

  // line 51
  (gdb) print vlaref
  $1 = (int (&)[3]) <error reading variable>

(in rare cases the memory address might even be valid and GDB would
print random output for the array) for references using the above
construct (the example is taken from vla-cxx.exp).  For Fortran pointers
one would run into a similar problem (from pointers.exp)

  // line 107
  (gdb) p intap
  $1 = (PTR TO -> ( INTEGER(4) (:,:) )) 0x4866e0 <pointers_$INTA>
  (gdb) p *intap
  value requires 8589934593 bytes, which is more than max-value-size

With this patch the above examples print as

  // line 51
  (gdb) print vlaref
  $1 = (int (&)[3]) @0x7fffffffc4e0: {5, 7, 9}

and

  // line 107
  (gdb) p intap
  $1 = (PTR TO -> ( INTEGER(4) (10,2) )) 0x4866e0 <pointers_$INTA>
  (gdb) p *intap
  $2 = ((1, 1, 3, 1, 1, 1, 1, 1, 1, 1) (1, 1, 1, 1, 1, 1, 1, 1, 1, 1))

greatly increasing usability of icc/icpc/ifort emitted objectfiles
inside GDB.

A test has been added to gdb.dwarf2 explicitly constructing both, the
wrong pointer and the wrong reference DWARF.
---
 gdb/gdbtypes.c                                |  74 ++++++++-
 gdb/gdbtypes.h                                |   5 +
 gdb/testsuite/gdb.cp/vla-cxx.exp              |  24 ++-
 .../icc-ifort-pointers-and-references.c       |  37 +++++
 .../icc-ifort-pointers-and-references.exp     | 150 ++++++++++++++++++
 gdb/testsuite/gdb.fortran/pointers.exp        |  86 ++++++++--
 gdb/valprint.c                                |  34 ++++
 7 files changed, 390 insertions(+), 20 deletions(-)
 create mode 100644 gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.exp

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 5eb4b649d5c..eccc56b10d4 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -43,6 +43,7 @@
 #include "f-lang.h"
 #include <algorithm>
 #include "gmp-utils.h"
+#include "producer.h"
 
 /* The value of an invalid conversion badness.  */
 #define INVALID_CONVERSION 100
@@ -2090,6 +2091,14 @@ is_dynamic_type_internal (struct type *type, int top_level)
   if (top_level
       && (type->code () == TYPE_CODE_REF || type->code () == TYPE_CODE_PTR))
     type = check_typedef (type->target_type ());
+  if (!top_level && icc_pointer_or_reference_type (type))
+    {
+      /* Icc/ifort emit the DW_AT_associated for pointers and references.  To
+	 not mark such types as dynamic further down, which would lead to
+	 infinite resolution loops for, e.g., cyclic dynamic pointers, we
+	 return here already.  */
+      return 0;
+    }
 
   /* Types that have a dynamic TYPE_DATA_LOCATION are considered
      dynamic, even if the type itself is statically defined.
@@ -2791,6 +2800,22 @@ resolve_dynamic_struct (struct type *type,
   return resolved_type;
 }
 
+/* See gdbtypes.h.  */
+
+bool
+icc_pointer_or_reference_type (const struct type *type)
+{
+  return (type->code () == TYPE_CODE_PTR || type->code () == TYPE_CODE_REF)
+	 && type->is_objfile_owned ()
+	 && std::any_of (type->objfile_owner ()->compunits ().begin (),
+			 type->objfile_owner ()->compunits ().end (),
+			 [] (const compunit_symtab *cu)
+			 {
+			   return producer_is_icc (cu->producer (), nullptr,
+						   nullptr);
+			 });
+}
+
 /* Worker for resolved_dynamic_type.  */
 
 static struct type *
@@ -2830,20 +2855,65 @@ resolve_dynamic_type_internal (struct type *type,
 	case TYPE_CODE_PTR:
 	  {
 	    struct property_addr_info pinfo;
+	    bool icc_source = false;
 
 	    pinfo.type = check_typedef (type->target_type ());
 	    pinfo.valaddr = {};
 	    if (addr_stack->valaddr.data () != NULL)
 	      pinfo.addr = extract_typed_address (addr_stack->valaddr.data (),
 						  type);
+	    else if ((icc_source = icc_pointer_or_reference_type (type))
+		     && TYPE_DATA_LOCATION (type->target_type ()) != nullptr)
+	      {
+		/* Icc/ifort emit some wrong DWARF for pointers and references
+		   with underlying arrays.  They emit DWARF like
+
+		   <2><11>: Abbrev Number: 22 (DW_TAG_variable)
+		      <12>   DW_AT_name        : ...
+		      <13>   DW_AT_type        : <0x214>
+		      <14>   DW_AT_location    : ...
+		   ...
+		   <1><111>: Abbrev Number: 12 (DW_TAG_reference_type)
+		      <112>   DW_AT_type        : <0x219>
+		   <1><113>: Abbrev Number: 27 (DW_TAG_array_type)
+		      <114>   DW_AT_type        : <0x10e>
+		      <115>   DW_AT_data_location: 2 byte block: 97 6
+			(DW_OP_push_object_address; DW_OP_deref)
+		   <2><116>: Abbrev Number: 28 (DW_TAG_subrange_type)
+		      <117>   DW_AT_upper_bound : <0x154>
+		   <2><118>: Abbrev Number: 0
+
+		   For icc/ifort the DW_AT_data_location require the address
+		   of the original DW_TAG_variable for the evaluation of
+		   DW_OP_push_object_address instead of the address of
+		   the DW_TAG_array_type typically obtained by resolving
+		   dereferencing the DW_TAG_reference_type/DW_TAG_pointer_type
+		   once.  If icc/ifort are detected as producers here and if
+		   the type underlying the current pointer/reference variable
+		   has a DW_AT_data_location, we thus pass the address of
+		   the variable to resolve the target type instead of the
+		   dereferenced address of the pointer/reference.  */
+		pinfo.addr = addr_stack->addr;
+	      }
 	    else
 	      pinfo.addr = read_memory_typed_address (addr_stack->addr, type);
 	    pinfo.next = addr_stack;
 
 	    resolved_type = copy_type (type);
 
-	    /* For pointers the target address might not be set yet.  */
-	    if (pinfo.addr != 0)
+	    /* Another peculiarity of icc's/ifort's dwarf is the usage of
+	       DW_AT_associated for pointers/references.  */
+	    if (icc_source)
+	      {
+		prop = TYPE_ASSOCIATED_PROP (resolved_type);
+		if (prop != nullptr
+		    && dwarf2_evaluate_property (prop, nullptr, addr_stack,
+						 &value))
+		prop->set_const_val (value);
+	      }
+
+	    if (pinfo.addr != 0 &&
+		(!icc_source || !type_not_associated (resolved_type)))
 	      resolved_type->set_target_type
 		(resolve_dynamic_type_internal (type->target_type (),
 						&pinfo, top_level));
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 94d4b6684fb..4e8f63c549f 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -2937,4 +2937,9 @@ extern unsigned int overload_debug;
 
 extern bool is_nocall_function (const struct type *type);
 
+/* Check whether icc/ifort could have been the producers of the TYPE_CODE_REF
+   or TYPE_CODE_PTR type.  */
+
+extern bool icc_pointer_or_reference_type (const struct type *type);
+
 #endif /* GDBTYPES_H */
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index bb94bce4e6a..06b8915a62e 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -26,11 +26,27 @@ if ![runto_main] {
 gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
 gdb_continue_to_breakpoint "Before pointer assignment"
 
-gdb_test "ptype ptr" "= int \\(\\*\\)\\\[variable length\\\]" \
-    "ptype ptr, Before pointer assignment"
+gdb_test_multiple "ptype ptr" "ptype ptr, Before pointer assignment" {
+    # gcc/icx.
+    -re -wrap "= int \\(\\*\\)\\\[variable length\\\]" {
+      pass $gdb_test_name
+    }
+    # icc.
+    -re -wrap "= int \\(\\*\\)\\\[3\\\]" {
+      pass $gdb_test_name
+    }
+}
 
-gdb_test "print ptr" "= \\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" \
-    "print ptr, Before pointer assignment"
+gdb_test_multiple "print ptr" "print ptr, Before pointer assignment" {
+    # gcc/icx.
+    -re -wrap "= \\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" {
+      pass $gdb_test_name
+    }
+    # icc.
+    -re -wrap "= \\(int \\(\\*\\)\\\[3\\\]\\) 0x0" {
+      pass $gdb_test_name
+    }
+}
 
 gdb_test "print *ptr" "Cannot access memory at address 0x0" \
     "print *ptr, Before pointer assignment"
diff --git a/gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.c b/gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.c
new file mode 100644
index 00000000000..cddc30b8833
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.c
@@ -0,0 +1,37 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2021-2022 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/>.  */
+struct fat_pointer
+{
+  int *associated;
+  int *size;
+  int *data;
+};
+
+int one[] = {1};
+int zero1[] = {0};
+int zero2[] = {0};
+int four[] = {4};
+int data[] = {11, 22, 33, 44};
+
+struct fat_pointer fp_associated = {one, four, data};
+struct fat_pointer fp_not_associated = {zero1, zero2, 0};
+
+int
+main ()
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.exp b/gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.exp
new file mode 100644
index 00000000000..f318c99ae6f
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/icc-ifort-pointers-and-references.exp
@@ -0,0 +1,150 @@
+# Copyright 2022 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/>.
+
+# This test checks that GDB can handle some slighlty wrong DWARF that is being
+# produces by icc/icpc/ifort for pointers and references.  Namely the DWARF
+# looks like
+#
+# <2><17d>: Abbrev Number: 22 (DW_TAG_variable)
+#    <17e>   DW_AT_decl_line   : 41
+#    <17f>   DW_AT_decl_file   : 1
+#    <180>   DW_AT_name        : (indirect string, offset: 0x1f1): vlaref
+#    <184>   DW_AT_type        : <0x214>
+#    <188>   DW_AT_location    : 2 byte block: 76 50
+#      (DW_OP_breg6 (rbp): -48)
+# ...
+# <1><214>: Abbrev Number: 12 (DW_TAG_reference/pointer_type)
+#    <215>   DW_AT_type        : <0x219>
+#    <216>   DW_AT_associated  : ...     <- for Fortran pointers
+# <1><219>: Abbrev Number: 27 (DW_TAG_array_type)
+#    <21a>   DW_AT_type        : <0x10e>
+#    <21e>   DW_AT_data_location: 2 byte block: 97 6
+#      (DW_OP_push_object_address; DW_OP_deref)
+# <2><221>: Abbrev Number: 28 (DW_TAG_subrange_type)
+#    <222>   DW_AT_upper_bound : <0x154>
+# <2><226>: Abbrev Number: 0
+#
+# With a) DW_OP_push_object_address expecting the address of the
+# DW_TAG_variable used for its resolution instead of the address of the
+# underlying array and b) some Fortran pointers exhibiting the DW_AT_associated
+# attribute on DW_TAG_pointer_types.
+# To test a) this test constructs a pointer and a reference type to an array
+# with the above usage of DW_AT_data_location and DW_OP_push_object_address.
+# To test b) we simply create a pointer with the DW_AT_associated attribute
+# an check whether this is being resolved or not.
+
+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 {
+    global srcfile
+    set int_size [get_sizeof "int" 4]
+    set voidp_size [get_sizeof "void *" 96]
+    declare_labels integer_label array_label pointer_label
+
+    cu {} {
+	compile_unit {
+	    {DW_AT_language @DW_LANG_Fortran90}
+	    {DW_AT_name $srcfile}
+	    {DW_AT_producer "Intel(R) compiler VERSION 123.456"}
+	    {DW_AT_comp_dir /tmp}
+	} {
+	    integer_label: DW_TAG_base_type {
+		{name "int"}
+		{byte_size $int_size sdata}
+		{encoding @DW_ATE_signed}
+	    }
+
+	    array_label: DW_TAG_array_type {
+		{DW_AT_type :$integer_label}
+		{DW_AT_data_location {
+		    DW_OP_push_object_address
+		    DW_OP_plus_uconst $voidp_size
+		    DW_OP_plus_uconst $voidp_size
+		    DW_OP_deref
+		} SPECIAL_expr}
+	    } {
+		DW_TAG_subrange_type {
+		    {DW_AT_type :$integer_label}
+		    {DW_AT_upper_bound {
+			DW_OP_push_object_address
+			DW_OP_plus_uconst $voidp_size
+			DW_OP_deref
+			DW_OP_deref_size $int_size
+		     } SPECIAL_expr }
+		}
+	    }
+
+	    pointer_label: DW_TAG_pointer_type {
+		{DW_AT_type :$array_label}
+		{DW_AT_associated {
+		    DW_OP_push_object_address
+		    DW_OP_deref
+		    DW_OP_deref_size $int_size
+		    DW_OP_constu 0
+		    DW_OP_ne
+		} SPECIAL_expr }
+	    }
+
+	    DW_TAG_variable {
+		{DW_AT_name "fp_associated"}
+		{DW_AT_type :$pointer_label}
+		{DW_AT_location {
+		    DW_OP_addr [gdb_target_symbol fp_associated]
+		} SPECIAL_expr}
+	    }
+
+	    DW_TAG_variable {
+		{DW_AT_name "fp_not_associated"}
+		{DW_AT_type :$pointer_label}
+		{DW_AT_location {
+		    DW_OP_addr [gdb_target_symbol fp_not_associated]
+		} SPECIAL_expr}
+	    }
+	}
+    }
+}
+
+if { [prepare_for_testing "failed to prepare" ${testfile} \
+	  [list $srcfile $asm_file] {nodebug}] } {
+    return -1
+}
+
+if ![runto_main] {
+    return -1
+}
+
+gdb_test_no_output "set language fortran"
+gdb_test "p associated(fp_associated)" "\\.TRUE\\."
+gdb_test "p associated(fp_not_associated)" "\\.FALSE\\."
+gdb_test "p fp_not_associated" \
+    " = \\(PTR TO -> \\( int \\(:\\) \\)\\) <not associated>"
+gdb_test "p *fp_not_associated" "Cannot access memory at address 0x0"
+
+gdb_test "p fp_associated" "= \\(PTR TO -> \\( int \\(4\\) \\)\\) $hex <.*>"
+gdb_test "p *fp_associated" "= \\(11, 22, 33, 44\\)"
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
index c7a60fec6b6..fd1dee7ed5a 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -54,17 +54,45 @@ gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" \
     "print intp, not associated"
 gdb_test "print *intp" "Cannot access memory at address 0x0" \
     "print *intp, not associated"
-gdb_test "print intap" " = <not associated>" "print intap, not associated"
+
+gdb_test_multiple "print intap" "print intap, not associated" {
+    # gfortran/ifx.
+    -re -wrap " = <not associated>" {
+	pass $gdb_test_name
+    }
+    # ifort.
+    -re -wrap " = \\(PTR TO -> \\( $int \\(:,:\\) \\)\\) <not associated>" {
+	pass $gdb_test_name
+    }
+}
+
 gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" \
     "print realp, not associated"
 gdb_test "print *realp" "Cannot access memory at address 0x0" \
     "print *realp, not associated"
 gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
-gdb_test "print cyclicp1" "= \\( i = -?\\d+, p = 0x0 \\)" \
-    "print cyclicp1, not associated"
-gdb_test "print cyclicp1%p" \
-    "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0" \
-    "print cyclicp1%p, not associated"
+
+gdb_test_multiple "print cyclicp1" "print cyclicp1, not associated" {
+    # gfortran/ifx.
+    -re -wrap "= \\( i = -?\\d+, p = 0x0 \\)" {
+	pass $gdb_test_name
+    }
+    # ifort.
+    -re -wrap "= \\( i = -?\\d+, p = <not associated> \\)" {
+	pass $gdb_test_name
+    }
+}
+
+gdb_test_multiple "print cyclicp1%p" "print cyclicp1%p, not associated" {
+    # gfortran/ifx.
+    -re -wrap "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0" {
+	pass $gdb_test_name
+    }
+    # ifort.
+    -re -wrap "= \\(PTR TO -> \\( Type typewithpointer \\)\\) <not associated>" {
+	pass $gdb_test_name
+    }
+}
 
 gdb_breakpoint [gdb_get_line_number "Before value assignment"]
 gdb_continue_to_breakpoint "Before value assignment"
@@ -82,25 +110,55 @@ gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?"
 gdb_test "print *charap" "= 'abc'"
 gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?"
 gdb_test "print *intp" "= 10"
-gdb_test "print intap" "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)" \
-    "print intap, associated"
-gdb_test "print intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)" \
-    "print intvlap, associated"
+
+gdb_test_multiple "print intap" "print intap, associated" {
+    # gfortran/ifx.
+    -re -wrap "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)" {
+	pass $gdb_test_name
+    }
+    # ifort.
+    -re -wrap "= \\(PTR TO -> \\( $int \\(10,2\\) \\)\\) $hex\( <.*>\)?" {
+	gdb_test "print *intap" "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)"
+	pass $gdb_test_name
+    }
+}
+
+gdb_test_multiple "print intvlap" "print intvlap, associated" {
+    # gfortran/ifx.
+    -re -wrap "= \\(2, 2, 2, 4(, 2){6}\\)" {
+	pass $gdb_test_name
+    }
+    # ifort.
+    -re -wrap "= \\(PTR TO -> \\( $int \\(10\\) \\)\\) $hex\( <.*>\)?" {
+	gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)"
+	pass $gdb_test_name
+    }
+}
+
 gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?"
 gdb_test "print *realp" "= 3\\.14000\\d+"
 gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
 gdb_test "print *(arrayOfPtr(2)%p)" \
     "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\(211, 221\\) \\(212, 222\\)\\) \\)"
-gdb_test "print arrayOfPtr(3)%p" "= \\(PTR TO -> \\( Type two \\)\\) 0x0" \
-    "print arrayOfPtr(3)%p"
+
+gdb_test_multiple "print arrayOfPtr(3)%p" "print arrayOfPtr(3)%p" {
+    # gfortran/ifx
+    -re -wrap "= \\(PTR TO -> \\( Type two \\)\\) 0x0" {
+	pass $gdb_test_name
+    }
+    # ifort
+     -re -wrap "= \\(PTR TO -> \\( Type two \\)\\) <not associated>" {
+	pass $gdb_test_name
+    }
+}
 
 gdb_test_multiple "print *(arrayOfPtr(3)%p)" \
     "print *(arrayOfPtr(3)%p), associated" {
-    # gfortran
+    # gfortran.
     -re -wrap "Cannot access memory at address 0x0" {
 	pass $gdb_test_name
     }
-    # ifx
+    # ifx/ifort.
     -re -wrap "Location address is not set." {
 	pass $gdb_test_name
     }
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 258885b4471..c6a2aab8018 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -564,6 +564,40 @@ generic_val_print_ref (struct type *type,
 	  /* More complicated computed references are not supported.  */
 	  gdb_assert (embedded_offset == 0);
 	}
+      else if (icc_pointer_or_reference_type (type)
+	       && TYPE_DATA_LOCATION (type->target_type ()) != nullptr)
+	{
+	  /* Icc/ifort emit some wrong DWARF for pointers and references
+	     with underlying arrays.  They emit DWARF like
+
+	     <2><11>: Abbrev Number: 22 (DW_TAG_variable)
+		<12>   DW_AT_name        : ...
+		<13>   DW_AT_type        : <0x214>
+		<14>   DW_AT_location    : ...
+	     ...
+	     <1><111>: Abbrev Number: 12 (DW_TAG_reference_type)
+		<112>   DW_AT_type        : <0x219>
+	     <1><113>: Abbrev Number: 27 (DW_TAG_array_type)
+		<114>   DW_AT_type        : <0x10e>
+		<115>   DW_AT_data_location: 2 byte block: 97 6
+		(DW_OP_push_object_address; DW_OP_deref)
+	     <2><116>: Abbrev Number: 28 (DW_TAG_subrange_type)
+		<117>   DW_AT_upper_bound : <0x154>
+	     <2><118>: Abbrev Number: 0
+
+	     For icc/ifort the DW_AT_data_location require the address
+	     of the original DW_TAG_variable for the evaluation of
+	     DW_OP_push_object_address instead of the address of
+	     the DW_TAG_array_type typically obtained by resolving
+	     dereferencing the DW_TAG_reference_type/DW_TAG_pointer_type
+	     once.  If icc/ifort are detected as producers here and if
+	     the type underlying the current pointer/reference variable
+	     has a DW_AT_data_location, we thus pass the address of
+	     the variable to resolve the target type instead of the
+	     dereferenced address of the pointer/reference.  */
+	    deref_val = value_at (type->target_type (),
+				  value_address (original_value));
+	  }
       else
 	deref_val = value_at (type->target_type (),
 			      unpack_pointer (type, valaddr + embedded_offset));
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v2 4/4] gdb/fortran: Fix sizeof intrinsic for Fortran

[Nils-Christian Kempke]

The sizeof operator in Fortran behaves differently from e.g. C/Cpp in
that it can be applied to pointers.  We thus dereference pointers before
evaluating their size.  A test has been added for the Fortran sizeof
operator.
---
 gdb/eval.c                           |   3 +
 gdb/testsuite/gdb.fortran/sizeof.exp | 115 +++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/sizeof.f90 | 108 +++++++++++++++++++++++++
 3 files changed, 226 insertions(+)
 create mode 100644 gdb/testsuite/gdb.fortran/sizeof.exp
 create mode 100644 gdb/testsuite/gdb.fortran/sizeof.f90

diff --git a/gdb/eval.c b/gdb/eval.c
index 55e130d738d..deef630dc76 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -2730,6 +2730,9 @@ evaluate_subexp_for_sizeof_base (struct expression *exp, struct type *type)
   if (exp->language_defn->la_language == language_cplus
       && (TYPE_IS_REFERENCE (type)))
     type = check_typedef (type->target_type ());
+  else if (exp->language_defn->la_language == language_fortran
+	   && type->code () == TYPE_CODE_PTR)
+    type = check_typedef (type->target_type ());
   return value_from_longest (size_type, (LONGEST) type->length ());
 }
 
diff --git a/gdb/testsuite/gdb.fortran/sizeof.exp b/gdb/testsuite/gdb.fortran/sizeof.exp
new file mode 100644
index 00000000000..a7d69293bb4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/sizeof.exp
@@ -0,0 +1,115 @@
+# Copyright 2022 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/> .
+
+# Testing GDB's implementation of SIZE keyword.
+
+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] {
+    return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Test breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Past unassigned pointers"]
+gdb_breakpoint [gdb_get_line_number "Final breakpoint"]
+
+set done_unassigned 0
+set found_final_breakpoint 0
+set test_count 0
+
+# We are running tests defined in the executable here.  So, in the .exp file
+# we do not know when the 'Final breakpoint' will be hit exactly.  We place a
+# limit on the number of tests that can be run, just in case something goes
+# wrong, and GDB gets stuck in an loop here.
+while { $test_count < 200 } {
+    with_test_prefix "test $test_count" {
+	incr test_count
+
+	gdb_test_multiple "continue" "continue" {
+	    -re -wrap "! Test breakpoint" {
+		# We can run a test from here.
+	    }
+	    -re -wrap "! Past unassigned pointers" {
+		# Done with testing unassigned pointers.
+		set done_unassigned 1
+		continue
+	    }
+	    -re -wrap "! Final breakpoint" {
+		# We're done with the tests.
+		set found_final_breakpoint 1
+	    }
+	}
+
+	if ($found_final_breakpoint) {
+	    break
+	}
+
+	# First grab the expected answer.
+	set answer [get_valueof "" "answer" "**unknown**"]
+
+	# Now move up a frame and figure out a command for us to run
+	# as a test.
+	set command ""
+	gdb_test_multiple "up" "up" {
+	    -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_sizeof \\((\[^\r\n\]+)\\)" {
+		set command $expect_out(1,string)
+	    }
+	}
+
+	gdb_assert { ![string equal $command ""] } "found a command to run"
+
+	set is_pointer_to_array [string match "sizeof (*a_p)*" $command]
+
+	if {$done_unassigned || !$is_pointer_to_array} {
+	    gdb_test "p $command" " = $answer"
+	} else {
+	    # Gfortran, ifx and ifort have slightly differnt behavior for
+	    # unassigned pointers to arrays.  While ifx and ifort will print 0
+	    # as the sizeof result, gfortran will print the size of the base
+	    # type of the pointer/array.  Since the default behavior in GDB was
+	    # to print 0 we keep this and make an exception for gfortran here.
+	    gdb_test_multiple "p $command" "p $command" {
+		-re -wrap " = $answer" {
+		    pass $gdb_test_name
+		}
+		-re -wrap " = 0" {
+		    pass $gdb_test_name
+		}
+	    }
+	}
+    }
+}
+
+gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
+
+# Here some more GDB specific tests that might fail with compilers.
+# GDB will print sizeof(1.4) = 8 while gfortran will probably print 4 but
+# GDB says ptype 1.4 is real*8 so the output is expected.
+
+gdb_test "ptype 1" "type = int"
+gdb_test "p sizeof(1)" "= 4"
+
+gdb_test "ptype 1.3" "type = real\\*8"
+gdb_test "p sizeof(1.3)" "= 8"
+
+gdb_test  "p sizeof ('asdsasd')" "= 7"
diff --git a/gdb/testsuite/gdb.fortran/sizeof.f90 b/gdb/testsuite/gdb.fortran/sizeof.f90
new file mode 100644
index 00000000000..60107e958e8
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/sizeof.f90
@@ -0,0 +1,108 @@
+! Copyright 2022 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 data
+  use, intrinsic :: iso_c_binding, only : C_SIZE_T
+  implicit none
+
+  character, target :: char_v
+  character (len=3), target :: char_a
+  integer, target :: int_v
+  integer, target, dimension(:,:) :: int_2da (3,2)
+  real*4, target :: real_v
+  real*4, target :: real_a(4)
+  real*4, target, dimension (:), allocatable :: real_a_alloc
+
+  character, pointer :: char_v_p
+  character (len=3), pointer :: char_a_p
+  integer, pointer :: int_v_p
+  integer, pointer, dimension (:,:) :: int_2da_p
+  real*4, pointer :: real_v_p
+  real*4, pointer, dimension(:) :: real_a_p
+  real*4, dimension(:), pointer :: real_alloc_a_p
+
+contains
+subroutine test_sizeof (answer)
+  integer(C_SIZE_T) :: answer
+
+  print *, answer ! Test breakpoint
+end subroutine test_sizeof
+
+subroutine run_tests ()
+  call test_sizeof (sizeof (char_v))
+  call test_sizeof (sizeof (char_a))
+  call test_sizeof (sizeof (int_v))
+  call test_sizeof (sizeof (int_2da))
+  call test_sizeof (sizeof (real_v))
+  call test_sizeof (sizeof (real_a))
+  call test_sizeof (sizeof (real_a_alloc))
+
+  call test_sizeof (sizeof (char_v_p))
+  call test_sizeof (sizeof (char_a_p))
+  call test_sizeof (sizeof (int_v_p))
+  call test_sizeof (sizeof (int_2da_p))
+  call test_sizeof (sizeof (real_v_p))
+  call test_sizeof (sizeof (real_a_p))
+  call test_sizeof (sizeof (real_alloc_a_p))
+end subroutine run_tests
+
+end module data
+
+program sizeof_tests
+  use iso_c_binding
+  use data
+
+  implicit none
+
+  allocate (real_a_alloc(5))
+
+  nullify (char_v_p)
+  nullify (char_a_p)
+  nullify (int_v_p)
+  nullify (int_2da_p)
+  nullify (real_v_p)
+  nullify (real_a_p)
+  nullify (real_alloc_a_p)
+
+  ! Test nullified
+  call run_tests ()
+
+  char_v_p => char_v ! Past unassigned pointers
+  char_a_p => char_a
+  int_v_p => int_v
+  int_2da_p => int_2da
+  real_v_p => real_v
+  real_a_p => real_a
+  real_alloc_a_p => real_a_alloc
+
+  ! Test pointer assignment
+  call run_tests ()
+
+  char_v = 'a'
+  char_a = "aaa"
+  int_v = 10
+  int_2da = reshape((/1, 2, 3, 4, 5, 6/), shape(int_2da))
+  real_v = 123.123
+  real_a_p = (/-1.1, -1.2, -1.3, -1.4/)
+  real_a_alloc = (/1.1, 2.2, 3.3, 4.4, 5.5/)
+
+  ! After allocate/value assignment
+  call run_tests ()
+
+  deallocate (real_a_alloc)
+
+  print *, "done" ! Final breakpoint
+
+end program sizeof_tests
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

Re: [PATCH v2 2/4] gdb/types: Resolve pointer types dynamically

[Tom Tromey]

>>>>> Nils-Christian Kempke via Gdb-patches <gdb-patches@sourceware.org> writes:

> -  if (type_not_associated (value_type (val)))
> -    {
> -      val_print_not_associated (stream);
> -      return 0;
> -    }
> -

I don't really understand the importance of this hunk, but I do see what
appear to be tests for this output, so if those still pass I suppose
this code is redundant and therefore the patch is ok.

Tom

Re: [PATCH v2 3/4] gdb, typeprint: workaround icc/icpc/ifort pointer/reference DWARF

[Tom Tromey]

>>>>> Nils-Christian Kempke via Gdb-patches <gdb-patches@sourceware.org> writes:

> Intel classic compilers (icc/icpc/ifort) for references/pointers
> to arrays generate DWARF that looks like

Thank you for the patch.

> +  if (!top_level && icc_pointer_or_reference_type (type))
> +    {
> +      /* Icc/ifort emit the DW_AT_associated for pointers and references.  To
> +	 not mark such types as dynamic further down, which would lead to
> +	 infinite resolution loops for, e.g., cyclic dynamic pointers, we
> +	 return here already.  */
> +      return 0;

I suspect this is not the best spot to do this kind of check.

> +bool
> +icc_pointer_or_reference_type (const struct type *type)
> +{
> +  return (type->code () == TYPE_CODE_PTR || type->code () == TYPE_CODE_REF)
> +	 && type->is_objfile_owned ()
> +	 && std::any_of (type->objfile_owner ()->compunits ().begin (),
> +			 type->objfile_owner ()->compunits ().end (),
> +			 [] (const compunit_symtab *cu)
> +			 {
> +			   return producer_is_icc (cu->producer (), nullptr,
> +						   nullptr);
> +			 });

And I really don't like this, because it's over-broad.  If an objfile
has objects from two different compilers, this code will erroneously
trigger.

Instead, it seems to me that a better approach would be to recognize
the oddities in the DWARF reader, and then perhaps either introduce new
types or mark the type somehow for later processing.

If you search for "quirk" it the reader, you'll see other examples of
this technique.  E.g., the Rust compiler used to emit a custom format
for Rust enums, and the code in the DWARF reader converts these types
into the internal representation used in the rest of gdb.

I'm not sure if this can completely be done in your case or not, but I
think it would be better to try.  If it fails, adding a new flag to the
type would be better than searching all the objfile's compunits.

Tom