]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
authorMikael Morin <mikael@gcc.gnu.org>
Sat, 21 Sep 2024 16:32:51 +0000 (18:32 +0200)
committerMikael Morin <mikael@gcc.gnu.org>
Sat, 21 Sep 2024 16:32:51 +0000 (18:32 +0200)
Enable the generation of inline code for MINLOC/MAXLOC when argument ARRAY
is of integral type, DIM is not present, and MASK is present and is scalar
(only absent MASK or rank 1 ARRAY were inlined before).

Scalar masks are implemented with a wrapping condition around the code one
would generate if MASK wasn't present, so they are easy to support once
inline code without MASK is working.

PR fortran/90608

gcc/fortran/ChangeLog:

* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate
variable initialization for each dimension in the else branch of
the toplevel condition.
(gfc_inline_intrinsic_function_p): Return TRUE for scalar MASK.

gcc/testsuite/ChangeLog:

* gfortran.dg/maxloc_bounds_7.f90: Additionally accept the error message
reported by the scalarizer.

gcc/fortran/trans-intrinsic.cc
gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90

index 64e88b089c44c75c57d50cdc2b48dae4e64ba82e..ed123f9f3adc0288e8a9661706275d3d670433b4 100644 (file)
@@ -5924,7 +5924,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   /* For a scalar mask, enclose the loop in an if statement.  */
   if (maskexpr && maskss == NULL)
     {
-      gcc_assert (loop.dimen == 1);
       tree ifmask;
 
       gfc_init_se (&maskse, NULL);
@@ -5939,7 +5938,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
         the pos variable the same way as above.  */
 
       gfc_init_block (&elseblock);
-      gfc_add_modify (&elseblock, pos[0], gfc_index_zero_node);
+      for (int i = 0; i < loop.dimen; i++)
+       gfc_add_modify (&elseblock, pos[i], gfc_index_zero_node);
       elsetmp = gfc_finish_block (&elseblock);
       ifmask = conv_mask_condition (&maskse, maskexpr, optional_mask);
       tmp = build3_v (COND_EXPR, ifmask, tmp, elsetmp);
@@ -11851,9 +11851,12 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
        if (array->rank == 1)
          return true;
 
-       if (array->ts.type == BT_INTEGER
-           && dim == nullptr
-           && mask == nullptr)
+       if (array->ts.type != BT_INTEGER
+           || dim != nullptr)
+         return false;
+
+       if (mask == nullptr
+           || mask->rank == 0)
          return true;
 
        return false;
index 206a29b149da8e94026989f4f05b60a5ae3ff2be..3aa9d3dcebee3f47edd882e11e1e1440550afa97 100644 (file)
@@ -1,6 +1,6 @@
 ! { dg-do run }
 ! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2|Array bound mismatch for dimension 1 of array 'res' .3/2." }
 module tst
 contains
   subroutine foo(res)
@@ -18,4 +18,4 @@ program main
   integer :: res(3)
   call foo(res)
 end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2|Array bound mismatch for dimension 1 of array 'res' .3/2." }