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

Message ID 20221005204039.575255-4-nils-christian.kempke@intel.com
State New
Headers
Series Dynamic properties of pointers |

Commit Message

Kempke, Nils-Christian Oct. 5, 2022, 8:40 p.m. UTC
  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
  

Comments

Tom Tromey Jan. 5, 2023, 7:46 p.m. UTC | #1
>>>>> 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
  

Patch

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));