https://gcc.gnu.org/g:4d9a71ceec40da31f781a495368250a1b92d5acb
commit r17-2719-g4d9a71ceec40da31f781a495368250a1b92d5acb Author: Jerry DeLisle <[email protected]> Date: Sun Jul 26 13:33:07 2026 -0700 fortran: Fix editorial error and new test case libgfortran/ChangeLog: * intrinsics/reduce.c (reduce): Fix the mask_present. gcc/testsuite/ChangeLog: * gfortran.dg/reduce_5.f90: Verify the previously dead code error message occurs. Diff: --- gcc/testsuite/gfortran.dg/reduce_5.f90 | 23 +++++++++++++++++++++++ libgfortran/intrinsics/reduce.c | 3 +-- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/reduce_5.f90 b/gcc/testsuite/gfortran.dg/reduce_5.f90 new file mode 100644 index 000000000000..00a7bb2dbead --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reduce_5.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-shouldfail "foo" } + + implicit none + integer :: a(3) + logical :: m(2) + a = 1 + m = .true. + print *, get_reduce (a, m) +contains + function get_reduce (array, mask) result (res) + integer, intent(in) :: array(:) + logical, intent(in) :: mask(:) + integer :: res + res = reduce (array, add, mask = mask, identity = 0) + end function get_reduce + pure function add (i, j) result (ij) + integer, intent(in) :: i, j + integer :: ij + ij = i + j + end function add +end +! { dg-output "shape mismatch between ARRAY and MASK in the REDUCE intrinsic \\(3/2\\)" } diff --git a/libgfortran/intrinsics/reduce.c b/libgfortran/intrinsics/reduce.c index 28bc834bc731..071d9486d119 100644 --- a/libgfortran/intrinsics/reduce.c +++ b/libgfortran/intrinsics/reduce.c @@ -54,7 +54,6 @@ reduce (parray *ret, index_type idx0, idx1, idx2; index_type dimen, dimen_m1, ldx, ext, str; bool started; - bool masked = false; bool dim_present = dim != NULL; bool mask_present = mask != NULL; bool identity_present = identity != NULL; @@ -106,7 +105,7 @@ reduce (parray *ret, ext = GFC_DESCRIPTOR_EXTENT (array,i); str = GFC_DESCRIPTOR_STRIDE (array,i); - if (masked && (ext != GFC_DESCRIPTOR_EXTENT (mask, i))) + if (mask_present && (ext != GFC_DESCRIPTOR_EXTENT (mask, i))) { int mext = (int)GFC_DESCRIPTOR_EXTENT (mask, i); runtime_error ("shape mismatch between ARRAY and MASK in the REDUCE "
