* [PATCH] Fortran: fix bounds check for assignment, class component [PR86100]
@ 2024-05-13 20:27 Harald Anlauf
2024-05-21 18:39 ` [PING] " Harald Anlauf
0 siblings, 1 reply; 2+ messages in thread
From: Harald Anlauf @ 2024-05-13 20:27 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 926 bytes --]
Dear all,
the attached patch does two things:
- it fixes a bogus array bounds check when deep-copying a class component
of a derived type and the class component has rank > 1, the reason being
that the previous code compared the full size of one side with the size
of the first dimension of the other
- the bounds-check error message that was generated e.g. by an allocate
statement with conflicting sizes in the allocation and the source-expr
will now use an improved abbreviated name pointing to the component
involved, which was introduced in 14-development.
What I could not resolve: a deep copy may still create no useful array
name in the error message (which I am now unable to trigger). If someone
sees how to extract it reliably from the tree, please let me know.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
I would like to backport this to 14-branch after a decent delay.
Thanks,
Harald
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr86100.diff --]
[-- Type: text/x-patch, Size: 5646 bytes --]
From e187285dfd83da2f69cfd50854c701744dc8acc5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 13 May 2024 22:06:33 +0200
Subject: [PATCH] Fortran: fix bounds check for assignment, class component
[PR86100]
gcc/fortran/ChangeLog:
PR fortran/86100
* trans-array.cc (gfc_conv_ss_startstride): Use abridged_ref_name
to generate a more user-friendly name for bounds-check messages.
* trans-expr.cc (gfc_copy_class_to_class): Fix bounds check for
rank>1 by looping over the dimensions.
gcc/testsuite/ChangeLog:
PR fortran/86100
* gfortran.dg/bounds_check_25.f90: New test.
---
gcc/fortran/trans-array.cc | 7 +++-
gcc/fortran/trans-expr.cc | 40 ++++++++++---------
gcc/testsuite/gfortran.dg/bounds_check_25.f90 | 32 +++++++++++++++
3 files changed, 60 insertions(+), 19 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_25.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c5b56f4e273..eec62c296ff 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4911,6 +4911,7 @@ done:
gfc_expr *expr;
locus *expr_loc;
const char *expr_name;
+ char *ref_name = NULL;
ss_info = ss->info;
if (ss_info->type != GFC_SS_SECTION)
@@ -4922,7 +4923,10 @@ done:
expr = ss_info->expr;
expr_loc = &expr->where;
- expr_name = expr->symtree->name;
+ if (expr->ref)
+ expr_name = ref_name = abridged_ref_name (expr, NULL);
+ else
+ expr_name = expr->symtree->name;
gfc_start_block (&inner);
@@ -5134,6 +5138,7 @@ done:
gfc_add_expr_to_block (&block, tmp);
+ free (ref_name);
}
tmp = gfc_finish_block (&block);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e315e2d3370..dfc5b8e9b4a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1520,7 +1520,6 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
stmtblock_t body;
stmtblock_t ifbody;
gfc_loopinfo loop;
- tree orig_nelems = nelems; /* Needed for bounds check. */
gfc_init_block (&body);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1552,27 +1551,32 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
/* Add bounds check. */
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
{
- char *msg;
const char *name = "<<unknown>>";
- tree from_len;
+ int dim, rank;
if (DECL_P (to))
- name = (const char *)(DECL_NAME (to)->identifier.id.str);
-
- from_len = gfc_conv_descriptor_size (from_data, 1);
- from_len = fold_convert (TREE_TYPE (orig_nelems), from_len);
- tmp = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, from_len, orig_nelems);
- msg = xasprintf ("Array bound mismatch for dimension %d "
- "of array '%s' (%%ld/%%ld)",
- 1, name);
-
- gfc_trans_runtime_check (true, false, tmp, &body,
- &gfc_current_locus, msg,
- fold_convert (long_integer_type_node, orig_nelems),
- fold_convert (long_integer_type_node, from_len));
+ name = IDENTIFIER_POINTER (DECL_NAME (to));
- free (msg);
+ rank = GFC_TYPE_ARRAY_RANK (TREE_TYPE (from_data));
+ for (dim = 1; dim <= rank; dim++)
+ {
+ tree from_len, to_len, cond;
+ char *msg;
+
+ from_len = gfc_conv_descriptor_size (from_data, dim);
+ from_len = fold_convert (long_integer_type_node, from_len);
+ to_len = gfc_conv_descriptor_size (to_data, dim);
+ to_len = fold_convert (long_integer_type_node, to_len);
+ msg = xasprintf ("Array bound mismatch for dimension %d "
+ "of array '%s' (%%ld/%%ld)",
+ dim, name);
+ cond = fold_build2_loc (input_location, NE_EXPR,
+ logical_type_node, from_len, to_len);
+ gfc_trans_runtime_check (true, false, cond, &body,
+ &gfc_current_locus, msg,
+ to_len, from_len);
+ free (msg);
+ }
}
tmp = build_call_vec (fcn_type, fcn, args);
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_25.f90 b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
new file mode 100644
index 00000000000..cc2247597f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bounds -fdump-tree-original" }
+!
+! PR fortran/86100 - bogus bounds check with assignment, class component
+
+program p
+ implicit none
+ type any_matrix
+ class(*), allocatable :: m(:,:)
+ end type any_matrix
+ type(any_matrix) :: a, b
+ allocate (a%m, source=reshape([3,5],shape=[1,2]))
+
+ ! The following assignment did create a bogus bounds violation:
+ b = a ! Line 15
+ if (any (shape (b%m) /= shape (a%m))) stop 1
+
+contains
+
+ ! Verify improved array name in array name
+ subroutine bla ()
+ type(any_matrix) :: c, d
+ allocate (real :: c%m(3,5))
+ allocate (d%m(7,9),source=c%m) ! Line 24
+ end subroutine bla
+end
+
+! { dg-final { scan-tree-dump-times "line 15 .* bound mismatch for dimension 1 of array .'.*.'" 1 "original" } }
+! { dg-final { scan-tree-dump-times "line 15 .* bound mismatch for dimension 2 of array .'.*.'" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "line 24 .* bound mismatch for dimension 1 of array .'d%%m.'" 1 "original" } }
+! { dg-final { scan-tree-dump-times "line 24 .* bound mismatch for dimension 2 of array .'d%%m.'" 1 "original" } }
--
2.35.3
^ permalink raw reply [flat|nested] 2+ messages in thread
* [PING] [PATCH] Fortran: fix bounds check for assignment, class component [PR86100]
2024-05-13 20:27 [PATCH] Fortran: fix bounds check for assignment, class component [PR86100] Harald Anlauf
@ 2024-05-21 18:39 ` Harald Anlauf
0 siblings, 0 replies; 2+ messages in thread
From: Harald Anlauf @ 2024-05-21 18:39 UTC (permalink / raw)
To: fortran, gcc-patches
Am 13.05.24 um 22:27 schrieb Harald Anlauf:
> Dear all,
>
> the attached patch does two things:
>
> - it fixes a bogus array bounds check when deep-copying a class component
> of a derived type and the class component has rank > 1, the reason being
> that the previous code compared the full size of one side with the size
> of the first dimension of the other
>
> - the bounds-check error message that was generated e.g. by an allocate
> statement with conflicting sizes in the allocation and the source-expr
> will now use an improved abbreviated name pointing to the component
> involved, which was introduced in 14-development.
>
> What I could not resolve: a deep copy may still create no useful array
> name in the error message (which I am now unable to trigger). If someone
> sees how to extract it reliably from the tree, please let me know.
>
> Regtested on x86_64-pc-linux-gnu. OK for mainline?
>
> I would like to backport this to 14-branch after a decent delay.
>
> Thanks,
> Harald
>
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2024-05-21 18:39 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-05-13 20:27 [PATCH] Fortran: fix bounds check for assignment, class component [PR86100] Harald Anlauf
2024-05-21 18:39 ` [PING] " Harald Anlauf
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).