Dear all,

the attached patch fixes a wrong-code issue with bounds-checking
enabled when doing I/O of an array section and an index is either
an expression or a function result.  The problem does not occur
without bounds-checking.

When looking at the original testcase, the function occuring in
the affected index was evaluated twice, once with wrong arguments.

The most simple solution appears to fall back to scalarization
with bounds-checking enabled.  If someone has a quick idea to
handle this better, please speak up!

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

This seems to be a 14/15 regression, so a backport is advisable.

Thanks,
Harald

From fa47a04e74a862ea4b85fa6f74b4b6ce21b61716 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Wed, 27 Nov 2024 21:11:16 +0100
Subject: [PATCH] Fortran: fix crash with bounds check writing array section
 [PR117791]

	PR fortran/117791

gcc/fortran/ChangeLog:

	* trans-io.cc (gfc_trans_transfer): When an array index depends on
	a function evaluation or an expression, do not use optimized array
	I/O of an array section and fall back to normal scalarization.

gcc/testsuite/ChangeLog:

	* gfortran.dg/bounds_check_array_io.f90: New test.
---
 gcc/fortran/trans-io.cc                       | 20 ++++++++++++
 .../gfortran.dg/bounds_check_array_io.f90     | 31 +++++++++++++++++++
 2 files changed, 51 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_array_io.f90

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 961a711c530..906dd7c6eb6 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2648,6 +2648,26 @@ gfc_trans_transfer (gfc_code * code)
 	     || gfc_expr_attr (expr).pointer))
 	goto scalarize;

+      /* With array-bounds checking enabled, force scalarization in some
+	 situations, e.g., when an array index depends on a function
+	 evaluation or an expression and possibly has side-effects.  */
+      if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+	  && ref
+	  && ref->u.ar.type == AR_SECTION)
+	{
+	  for (n = 0; n < ref->u.ar.dimen; n++)
+	    if (ref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+		&& ref->u.ar.start[n])
+	      {
+		switch (ref->u.ar.start[n]->expr_type)
+		  {
+		  case EXPR_FUNCTION:
+		  case EXPR_OP:
+		    goto scalarize;
+		  }
+	      }
+	}
+
       if (!(gfc_bt_struct (expr->ts.type)
 	      || expr->ts.type == BT_CLASS)
 	    && ref && ref->next == NULL
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_io.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_io.f90
new file mode 100644
index 00000000000..0cfc1174283
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_io.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bounds -fdump-tree-original" }
+!
+! PR fortran/117791 - crash with bounds check writing array section
+! Contributed by Andreas van Hameren (hameren at ifj dot edu dot pl)
+
+program testprogram
+  implicit none
+  integer, parameter :: array(4,2)=reshape ([11,12,13,14 ,15,16,17,18], [4,2])
+  integer            :: i(3) = [45,51,0]
+
+  write(*,*) 'line 1:',array(:,          sort_2(i(1:2)) )
+  write(*,*) 'line 2:',array(:,      3 - sort_2(i(1:2)) )
+  write(*,*) 'line 3:',array(:, int (3 - sort_2(i(1:2))))
+
+contains
+
+  function sort_2(i) result(rslt)
+    integer,intent(in) :: i(2)
+    integer            :: rslt
+    if (i(1) <= i(2)) then
+       rslt = 1
+    else
+       rslt = 2
+    endif
+  end function
+
+end program
+
+! { dg-final { scan-tree-dump-times "sort_2" 5 "original" } }
+! { dg-final { scan-tree-dump-not "_gfortran_transfer_array_write" "original" } }
--
2.35.3

Reply via email to