[PATCH v3 4/4] gdb, testsuite, fortran: Fix sizeof intrinsic for ifort Fortran pointers

[Abdul Basit Ijaz <abdul.b.ijaz@intel.com>]

From: "Ijaz, Abdul B" <abdul.b.ijaz@intel.com>

For Fortran pointers ifort emits actual DW_TAG_pointer_types like

<2><17d>: Abbrev Number: 22 (DW_TAG_variable)
   <180>   DW_AT_name        : (indirect string, offset: 0x1f1): fptr
   <184>   DW_AT_type        : <0x214>
...
<1><214>: Abbrev Number: 12 (DW_TAG_pointer_type)
   <215>   DW_AT_type        : <0x219>
   <216>   DW_AT_associated  : ...
<1><219>: Abbrev Number: 27 (DW_TAG_array_type)
   <21a>   DW_AT_type        : <0x10e>
...

whereas gfortran/ifx emit DWARF like

<2><17d>: Abbrev Number: 22 (DW_TAG_variable)
   <180>   DW_AT_name        : (indirect string, offset: 0x1f1): fptr
   <184>   DW_AT_type        : <0x214>
...
<1><219>: Abbrev Number: 27 (DW_TAG_array_type)
   <21a>   DW_AT_type        : <0x10e>
   <216>   DW_AT_associated  : ...

The 'pointer property' in Fortran is implicitly modeled by adding a
DW_AT_associated to the type of the variable (see also the
DW_AT_associated description in DWARF 5).  A Fortran pointer is more
than an address and thus different from a C pointer.  It is a
selfcontained type having additional fields such as, e.g., the rank of
its underlying array.  This motivates the intended DWARF modeling of
Fortran pointers (like gfortran and ifx do it) via the DW_AT_associated
attribute.

As ifort will not change its DWARF anymore and we still want to support
its DWARF we adapt GDB in the case of ifort Fortran pointers a bit.

This patch adds support for the sizeof intrinsic, which can now also be
applied to ifort pointer types by simply dereferencing them when
encountered during a sizeof evaluation.  Before, the application of sizeof
was only possible for gfortran's/ifx' Fortran pointers.

The patch also adds a test for the sizeof intrinsic which was not tested
before.
---
 gdb/eval.c                           |   9 +++
 gdb/testsuite/gdb.fortran/sizeof.exp | 115 +++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/sizeof.f90 | 108 +++++++++++++++++++++++++
 3 files changed, 232 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 794698f85bd..65408c2358b 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -2705,6 +2705,15 @@ 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)
+    {
+      /* IFORT emits DW_TAG_pointer_type for Fortran pointers.  While this is
+	 not the intended DWARF way of describing pointer types, we still
+	 support it here.  There is no harm in dereferencing such pointer types
+	 and allowing them for the Fortran sizeof intrinsic.  */
+      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..5e3710373ea
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/sizeof.exp
@@ -0,0 +1,115 @@
+# Copyright 2023 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.
+
+require allow_fortran_tests
+
+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 different 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..5f20a4effee
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/sizeof.f90
@@ -0,0 +1,108 @@
+! Copyright 2023 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.34.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