https://gcc.gnu.org/g:d3d4a1c4f55bdd97ed3acd4eda1547343d9b9066
commit d3d4a1c4f55bdd97ed3acd4eda1547343d9b9066
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 31 10:10:33 2024 +0200
fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
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.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 13 ++++++++-----
gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 | 4 ++--
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index ac8bd2d48123..855208717973 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5886,7 +5886,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);
@@ -5901,7 +5900,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);
@@ -11795,9 +11795,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;
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
index 206a29b149da..3aa9d3dcebee 100644
--- a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
@@ -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." }
