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

commit a0ea433dbba0dbe4beab23e3f2a2cb53960d4e42
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Sat Nov 18 20:54:20 2023 +0100

    fortran: Check for empty MINLOC/MAXLOC ARRAY along DIM only
    
    In the function generating inline code to implement MINLOC and MAXLOC, only
    get the size of ARRAY along DIM if DIM is present to check for emptyness.
    
    The check for ARRAY emptyness had been checking the size of the full array,
    which is correct for MINLOC and MAXLOC without DIM.  But if DIM is
    present, the reduction is along DIM only so the check for emptyness
    should consider that dimension only as well.
    
    This sounds like a correctness issue, but fortunately the cases where it
    makes a difference are cases where ARRAY is empty, so even if the MINLOC or
    MAXLOC calculated value is wrong, it's wrapped in a zero iteration loop, and
    the wrong values are not actually used.  In the end this just avoids
    unnecessary calculations.
    
    A previous version of this patch didn't support non-constant DIM with
    rank 1 ARRAY.  The new testcase checks that that case is supported.
    
    gcc/fortran/ChangeLog:
    
            * trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Only get the 
size
            along DIM instead of the full size if DIM is present.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/minmaxloc_22.f90: New test.

Diff:
---
 gcc/fortran/trans-intrinsic.cc             | 19 ++++++++++++++++++-
 gcc/testsuite/gfortran.dg/minmaxloc_22.f90 | 24 ++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 47964e63959f..44bb87dbbfe0 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5641,7 +5641,24 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * 
expr, enum tree_code op)
   if (!(maskexpr && maskexpr->rank > 0))
     {
       mpz_t asize;
-      if (gfc_array_size (arrayexpr, &asize))
+      bool reduction_size_known;
+
+      if (dim_present)
+       {
+         int reduction_dim;
+         if (dim_arg->expr->expr_type == EXPR_CONSTANT)
+           reduction_dim = mpz_get_si (dim_arg->expr->value.integer) - 1;
+         else if (arrayexpr->rank == 1)
+           reduction_dim = 0;
+         else
+           gcc_unreachable ();
+         reduction_size_known = gfc_array_dimen_size (arrayexpr, reduction_dim,
+                                                      &asize);
+       }
+      else
+       reduction_size_known = gfc_array_size (arrayexpr, &asize);
+
+      if (reduction_size_known)
        {
          nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
          mpz_clear (asize);
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_22.f90 
b/gcc/testsuite/gfortran.dg/minmaxloc_22.f90
new file mode 100644
index 000000000000..4f323ec5daba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_22.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! Check that the inline code generated for MINLOC and MAXLOC supports
+! a non-constant DIM argument if ARRAY has rank 1.
+
+program p
+  implicit none
+  integer, parameter :: n = 5
+  integer :: a(n)
+  print *, f(a, 1)
+contains
+  function f(a, d)
+    integer :: a(n)
+    integer :: d
+    integer :: f
+    f = minloc(a, dim=d) 
+  end function
+  function g(a, d)
+    integer :: a(n)
+    integer :: d
+    integer :: g
+    g = maxloc(a, dim=d) 
+  end function
+end program p

Reply via email to