]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
fortran: Check for empty MINLOC/MAXLOC ARRAY along DIM only
authorMikael Morin <mikael@gcc.gnu.org>
Sat, 18 Nov 2023 19:54:20 +0000 (20:54 +0100)
committerMikael Morin <mikael@gcc.gnu.org>
Wed, 20 Nov 2024 09:12:21 +0000 (10:12 +0100)
In the function generating inline code to implement MINLOC and MAXLOC, only
check for ARRAY size along DIM if DIM is present.

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 value
calculated for MINLOC or MAXLOC 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 regressed on 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.

gcc/fortran/trans-intrinsic.cc
gcc/testsuite/gfortran.dg/minmaxloc_22.f90 [new file with mode: 0644]

index 12bda2108bf444c0836a764c479612270c6e9f25..8b4fd8e23312efdb670aaf437ee066847b0f316e 100644 (file)
@@ -5642,7 +5642,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 (file)
index 0000000..ec97d14
--- /dev/null
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-additional-options "-O" }
+!
+! 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), i
+  a = (/ (i**2, i=1,n) /)
+  print *, f(a, 1), g(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