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
@@ -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;
}
}
@@ -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" }
@@ -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" } }
new file mode 100644
@@ -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" } }
@@ -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