[gcc r14-11065] Fortran: fix crash with bounds check writing array section [PR117791]

[Harald Anlauf via Gcc-cvs]

https://gcc.gnu.org/g:d3c18b92c97b0fd477c7a43ab7af1ed88faec4ba

commit r14-11065-gd3c18b92c97b0fd477c7a43ab7af1ed88faec4ba
Author: Harald Anlauf <anl...@gmx.de>
Date:   Wed Nov 27 21:11:16 2024 +0100

    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.
    
    (cherry picked from commit 2261a15c0715cbf5c129b66ee44fc1d3a9e36972)

Diff:
---
 gcc/fortran/trans-io.cc                            | 20 ++++++++++++++
 .../gfortran.dg/bounds_check_array_io.f90          | 31 ++++++++++++++++++++++
 2 files changed, 51 insertions(+)

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 0c5a1714be6f..c7a50e8839c8 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2633,6 +2633,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 000000000000..0cfc11742834
--- /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" 
} }