From cdf3b197beed0ce1649661b2132643b54cbade8d Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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