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.

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 961a711c530193cea63bc2841d494a10de874fb9..906dd7c6eb61b6dba804c744b3fb6a14581cf2ed 100644 (file)
--- 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 (file)
index 0000000..0cfc117
--- /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" } }