From 944a35909e8eeb79c92e398ae3f27e94708584e6 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 31 Aug 2023 22:19:58 +0200
Subject: [PATCH] Fortran: runtime bounds-checking in presence of array
 constructors [PR31059]

gcc/fortran/ChangeLog:

	PR fortran/31059
	* trans-array.cc (gfc_conv_ss_startstride): For array bounds checking,
	consider also array constructors in expressions, and use their shape.

gcc/testsuite/ChangeLog:

	PR fortran/31059
	* gfortran.dg/bounds_check_fail_5.f90: New test.
---
 gcc/fortran/trans-array.cc                    | 23 ++++++++++++++++
 .../gfortran.dg/bounds_check_fail_5.f90       | 26 +++++++++++++++++++
 2 files changed, 49 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_fail_5.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 90a7d4e9aef..6ca58e98547 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4740,6 +4740,29 @@ done:
       for (n = 0; n < loop->dimen; n++)
 	size[n] = NULL_TREE;

+      /* If there is a constructor involved, derive size[] from its shape.  */
+      for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+	{
+	  gfc_ss_info *ss_info;
+
+	  ss_info = ss->info;
+	  info = &ss_info->data.array;
+
+	  if (ss_info->type == GFC_SS_CONSTRUCTOR && info->shape)
+	    {
+	      for (n = 0; n < loop->dimen; n++)
+		{
+		  if (size[n] == NULL)
+		    {
+		      gcc_assert (info->shape[n]);
+		      size[n] = gfc_conv_mpz_to_tree (info->shape[n],
+						      gfc_index_integer_kind);
+		    }
+		}
+	      break;
+	    }
+	}
+
       for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
 	{
 	  stmtblock_t inner;
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_5.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_5.f90
new file mode 100644
index 00000000000..436cc96621d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_5.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bounds -g -fdump-tree-original" }
+! { dg-output "At line 13 .*" }
+! { dg-shouldfail "Array bound mismatch for dimension 1 of array 'ivec' (2/3)" }
+!
+! PR fortran/31059 - runtime bounds-checking in presence of array constructors
+
+program p
+  integer              :: jvec(3) = [1,2,3]
+  integer, allocatable :: ivec(:), kvec(:), lvec(:), mvec(:), nvec(:)
+  ivec    = [1,2]   ! (re)allocation
+  kvec    = [4,5,6] ! (re)allocation
+  ivec(:) = [4,5,6] ! runtime error (->dump)
+  ! not reached ...
+  print *, jvec + [1,2,3] ! OK & no check generated
+  print *, [4,5,6] + jvec ! OK & no check generated
+  print *, lvec + [1,2,3] ! check generated (->dump)
+  print *, [4,5,6] + mvec ! check generated (->dump)
+  nvec(:) = jvec          ! check generated (->dump)
+end
+
+! { dg-final { scan-tree-dump-times "Array bound mismatch " 4 "original" } }
+! { dg-final { scan-tree-dump-times "Array bound mismatch .*ivec" 1 "original" } }
+! { dg-final { scan-tree-dump-times "Array bound mismatch .*lvec" 1 "original" } }
+! { dg-final { scan-tree-dump-times "Array bound mismatch .*mvec" 1 "original" } }
+! { dg-final { scan-tree-dump-times "Array bound mismatch .*nvec" 1 "original" } }
--
2.35.3