]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
authorMikael Morin <mikael@gcc.gnu.org>
Sat, 13 Jul 2024 18:21:20 +0000 (20:21 +0200)
committerMikael Morin <mikael@gcc.gnu.org>
Sat, 13 Jul 2024 18:21:20 +0000 (20:21 +0200)
Add the preliminary code that the generated expression for MASK may depend
on when generating the inline code to evaluate MINLOC or MAXLOC with a
scalar MASK.

The generated code was only keeping the generated expression but not the
preliminary code, which was sufficient for simple cases such as data
references or simple (scalar) function calls, but was bogus with more
complicated ones.

gcc/fortran/ChangeLog:

* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Add the
preliminary code generated for MASK to the preliminary code of
MINLOC/MAXLOC.

gcc/testsuite/ChangeLog:

* gfortran.dg/minmaxloc_17.f90: New test.

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

index cadbd1774520bbefb5a36b7f90914e6008eb8063..180d0d7a88c6d703a935edfb584044efac31e581 100644 (file)
@@ -5749,6 +5749,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
 
       gfc_init_se (&maskse, NULL);
       gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_add_block_to_block (&se->pre, &maskse.pre);
       gfc_init_block (&block);
       gfc_add_block_to_block (&block, &loop.pre);
       gfc_add_block_to_block (&block, &loop.post);
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_17.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
new file mode 100644 (file)
index 0000000..7e6e586
--- /dev/null
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Check that the code necessary to evaluate MINLOC's or MAXLOC's MASK
+! argument is correctly generated.
+
+program p
+  implicit none
+  integer, parameter :: data10(*) = (/ 2, 5, 2, 0, 6, 5, 3, 6, 0, 1 /)
+  logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+                                       .false., .true., .true.,  &
+                                       .true. , .true., .false., &
+                                       .false. /)
+  type bool_wrapper
+    logical :: l
+  end type
+  call check_minloc
+  call check_maxloc
+contains
+  subroutine check_minloc
+    integer :: a(10)
+    integer :: r
+    a = data10
+    r = minloc(a, dim = 1, mask = sum(a) > 0)
+    if (r /= 4) stop 11
+  end subroutine
+  subroutine check_maxloc
+    integer :: a(10)
+    integer :: r
+    a = data10
+    r = maxloc(a, dim = 1, mask = sum(a) > 0)
+    if (r /= 5) stop 18
+  end subroutine
+end program