[PATCH, v2] Fortran: use name of array component in runtime error message [PR30802]

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 1206 bytes --]

Dear all,

after playing for some time with NAG and Intel, and an off-list
discussion with Jerry, I am getting more and more convinced that
simpler runtime error messages (also simpler to parse by a human)
are superior to awkward solutions.  This is also what Intel does:
use only the name of the array (component) in the message whose
indices are out of bounds.

(NAG's solution appears also inconsistent for nested derived types.)

So no x%z, or x%_data, etc. in runtime error messages any more.

Please give it a spin...

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


On 1/30/24 11:46, Mikael Morin wrote:
> Le 30/01/2024 à 11:38, Mikael Morin a écrit :
>>
>> Another (easier) way to clarify the data reference would be rephrasing
>> the message so that the array part is separate from the scalar part,
>> like so (there are too many 'of', but I lack inspiration):
>> Index '0' of dimension 1 of component 'zz' of element from 'x1%vv'
>> below lower bound of 1
>>
> This has the same number of 'of' but sounds better maybe:
> Out of bounds accessing component 'zz' of element from 'x1%yy': index
> '0' of dimension 1 below lower bound of 1
>

[-- Attachment #2: pr30802-part2-v2.diff --]
[-- Type: text/x-patch, Size: 9290 bytes --]

From cdf3b197beed0ce1649661b2132643b54cbade8d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 10 Mar 2024 22:14:30 +0100
Subject: [PATCH] Fortran: use name of array component in runtime error message
 [PR30802]

gcc/fortran/ChangeLog:

	PR fortran/30802
	* trans-array.cc (trans_array_bound_check): Find name of component
	to use in runtime error message.
	(array_bound_check_elemental): Likewise.
	(gfc_conv_array_ref): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/30802
	* gfortran.dg/bounds_check_17.f90: Adjust dg-pattern.
	* gfortran.dg/bounds_check_fail_6.f90: Likewise.
	* gfortran.dg/pr92050.f90: Likewise.
	* gfortran.dg/bounds_check_fail_8.f90: New test.
---
 gcc/fortran/trans-array.cc                    | 60 +++++++++----------
 gcc/testsuite/gfortran.dg/bounds_check_17.f90 |  2 +-
 .../gfortran.dg/bounds_check_fail_6.f90       |  7 ++-
 .../gfortran.dg/bounds_check_fail_8.f90       | 48 +++++++++++++++
 gcc/testsuite/gfortran.dg/pr92050.f90         |  2 +-
 5 files changed, 83 insertions(+), 36 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_fail_8.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 3673fa40720..9c62b070c50 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3497,6 +3497,8 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
   tree descriptor;
   char *msg;
   const char * name = NULL;
+  gfc_expr *expr;
+  gfc_ref *ref;
 
   if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
     return index;
@@ -3509,6 +3511,24 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
   name = ss->info->expr->symtree->n.sym->name;
   gcc_assert (name != NULL);
 
+  /* When we have a component ref, get name of the array section.
+     Note that there can only be one part ref.  */
+  expr = ss->info->expr;
+  if (expr->ref && !compname)
+    {
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  /* Remember component name.  */
+	  if (ref->type == REF_COMPONENT)
+	    {
+	      name = ref->u.c.component->name;
+	      continue;
+	    }
+	  if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+	    break;
+	}
+    }
+
   if (VAR_P (descriptor))
     name = IDENTIFIER_POINTER (DECL_NAME (descriptor));
 
@@ -3574,29 +3594,20 @@ array_bound_check_elemental (gfc_se * se, gfc_ss * ss, gfc_expr * expr)
   gfc_array_ref *ar;
   gfc_ref *ref;
   gfc_symbol *sym;
-  char *var_name = NULL;
-  size_t len;
+  const char *var_name = NULL;
   int dim;
 
   if (expr->expr_type == EXPR_VARIABLE)
     {
       sym = expr->symtree->n.sym;
-      len = strlen (sym->name) + 1;
-
-      for (ref = expr->ref; ref; ref = ref->next)
-	if (ref->type == REF_COMPONENT)
-	  len += 2 + strlen (ref->u.c.component->name);
-
-      var_name = XALLOCAVEC (char, len);
-      strcpy (var_name, sym->name);
+      var_name = sym->name;
 
       for (ref = expr->ref; ref; ref = ref->next)
 	{
-	  /* Append component name.  */
+	  /* Get component name.  */
 	  if (ref->type == REF_COMPONENT)
 	    {
-	      strcat (var_name, "%%");
-	      strcat (var_name, ref->u.c.component->name);
+	      var_name = ref->u.c.component->name;
 	      continue;
 	    }
 
@@ -4001,7 +4012,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
   gfc_se indexse;
   gfc_se tmpse;
   gfc_symbol * sym = expr->symtree->n.sym;
-  char *var_name = NULL;
+  const char *var_name = NULL;
 
   if (ar->dimen == 0)
     {
@@ -4035,30 +4046,17 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
 
   if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
     {
-      size_t len;
       gfc_ref *ref;
 
-      len = strlen (sym->name) + 1;
-      for (ref = expr->ref; ref; ref = ref->next)
-	{
-	  if (ref->type == REF_ARRAY && &ref->u.ar == ar)
-	    break;
-	  if (ref->type == REF_COMPONENT)
-	    len += 2 + strlen (ref->u.c.component->name);
-	}
-
-      var_name = XALLOCAVEC (char, len);
-      strcpy (var_name, sym->name);
+      var_name = sym->name;
 
       for (ref = expr->ref; ref; ref = ref->next)
 	{
 	  if (ref->type == REF_ARRAY && &ref->u.ar == ar)
 	    break;
-	  if (ref->type == REF_COMPONENT)
-	    {
-	      strcat (var_name, "%%");
-	      strcat (var_name, ref->u.c.component->name);
-	    }
+	  if (ref->type == REF_COMPONENT
+	      && strcmp (ref->u.c.component->name, "_data") != 0)
+	    var_name = ref->u.c.component->name;
 	}
     }
 
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_17.f90 b/gcc/testsuite/gfortran.dg/bounds_check_17.f90
index 50d66c75a80..41e119eadbe 100644
--- a/gcc/testsuite/gfortran.dg/bounds_check_17.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_17.f90
@@ -23,4 +23,4 @@ z(i)%y(j)%x(k)=0
 
 END
 
-! { dg-output "At line 22 of file .*bounds_check_17.f90.*Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' above upper bound of 10" }
+! { dg-output "At line 22 of file .*bounds_check_17.f90.*Fortran runtime error: Index '11' of dimension 1 of array 'x' above upper bound of 10" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_6.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_6.f90
index 90329131158..a549f0d5c23 100644
--- a/gcc/testsuite/gfortran.dg/bounds_check_fail_6.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_6.f90
@@ -1,7 +1,7 @@
 ! { dg-do run }
 ! { dg-additional-options "-fcheck=bounds -g -fdump-tree-original" }
 ! { dg-output "At line 18 .*" }
-! { dg-shouldfail "dimension 3 of array 'u%z' outside of expected range" }
+! { dg-shouldfail "dimension 3 of array 'z' outside of expected range" }
 !
 ! PR fortran/30802 - improve bounds-checking for array sections
 
@@ -25,5 +25,6 @@ contains
   end subroutine foo
 end program test
 
-! { dg-final { scan-tree-dump-times "'u%%z.' outside of expected range" 2 "original" } }
-! { dg-final { scan-tree-dump-times "'x.' outside of expected range" 4 "original" } }
+! { dg-final { scan-tree-dump-times "'z.' outside of expected range" 2 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'x.' outside of expected range" 2 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 3 of array .'x.' outside of expected range" 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_8.f90
new file mode 100644
index 00000000000..df1f9ca921a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_8.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! { dg-additional-options "-fcheck=bounds -g -fdump-tree-original" }
+!
+! PR fortran/30802 - improve bounds-checking for array references
+!
+! Use proper array component references in runtime error message.
+
+program test
+  implicit none
+  integer :: k = 0
+  type t
+     real, dimension(10,20,30) :: z = 23
+  end type t
+  type u
+     type(t) :: vv(4,5)
+     complex :: cc(6,7)
+  end type u
+  type vec
+     integer :: xx(3) = [2,4,6]
+  end type vec
+  type(t) :: uu,     ww(1)
+  type(u) :: x1, x2, y1(1), y2(1)
+
+  print *, uu   % z(1,k,:)           ! runtime check only for dimension 2 of z
+  print *, ww(1)% z(1,:,k)           ! runtime check only for dimension 3 of z
+  print *, x1   % vv(2,3)% z(1,:,k)  ! runtime check only for dimension 3 of z
+  print *, x2   % vv(k,:)% z(1,2,3)  ! runtime check only for dimension 1 of vv
+  print *, y1(1)% vv(2,3)% z(k,:,1)  ! runtime check only for dimension 1 of z
+  print *, y2(1)% vv(:,k)% z(1,2,3)  ! runtime check only for dimension 2 of vv
+  print *, y1(1)% cc(k,:)% re        ! runtime check only for dimension 1 of cc
+contains
+  subroutine sub (yy, k)
+    class(vec), intent(in) :: yy(:)
+    integer,    intent(in) :: k
+    print *, yy(1)%xx(k)
+  end
+end program test
+
+! { dg-final { scan-tree-dump-times "dimension 2 of array .'z.' outside of expected range" 2 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 3 of array .'z.' outside of expected range" 4 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'vv.' outside of expected range" 2 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'z.' outside of expected range" 2 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 2 of array .'vv.' outside of expected range" 2 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'cc.' outside of expected range" 2 "original" } }
+
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'yy.' above upper bound" 1 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'xx.' below lower bound" 1 "original" } }
+! { dg-final { scan-tree-dump-times "dimension 1 of array .'xx.' above upper bound" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/pr92050.f90 b/gcc/testsuite/gfortran.dg/pr92050.f90
index 64193878d8f..94d3f64d31a 100644
--- a/gcc/testsuite/gfortran.dg/pr92050.f90
+++ b/gcc/testsuite/gfortran.dg/pr92050.f90
@@ -50,4 +50,4 @@ program main
   call bad_update_foo(x)
 end program main
 
-! { dg-output "At line 39 of file .*pr92050.f90.*Fortran runtime error: Index '2' of dimension 1 of array 'this%m' above upper bound of 1" }
+! { dg-output "At line 39 of file .*pr92050.f90.*Fortran runtime error: Index '2' of dimension 1 of array 'm' above upper bound of 1" }
-- 
2.35.3