re PR libfortran/25378 ([Fortran 2003] maxloc for all-false mask)

2006-03-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25378
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set the initial position to zero and
	modify the condition for updating it, to implement the F2003 requirement for all(mask)
	is false.

2006-03-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25378
	* libgfortran/m4/minloc1.m4: Set the initial position to zero and modify the condition for
	updating it, to implement the F2003 requirement for all(mask).eq.false.
	* libgfortran/m4/maxloc1.m4: The same.
	* libgfortran/m4/iforeach.m4: The same.
	* libgfortran/m4/minloc0.m4: The same.
	* libgfortran/m4/maxloc0.m4: The same.
	* libgfortran/generated/maxloc0_16_i16.c: Regenerated, together with 41 others.
	* libgfortran/generated/minloc0_16_i16.c: Regenerated, together with 41 others.

2006-03-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25378
	* gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90: Expand test to include more
	permuatations of mask and index.
	* testsuite/gfortran.dg/scalar_mask_1.f90: Modify last test to respond to F2003 spec.
	that the position returned for an all false mask && condition is zero.

From-SVN: r112028

5 files changed, 55 insertions, 25 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b1c5864..b5f7d73 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2006-03-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25378
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set the initial position to zero and
+	modify the condition for updating it, to implement the F2003 requirement for all(mask)
+	is false.
+
 2006-03-13  Jakub Jelinek  <jakub@redhat.com>
 
 	* trans-openmp.c (gfc_trans_omp_variable): Handle references
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c6a2313..33350cbfa 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1671,7 +1671,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
   tree tmp;
   tree elsetmp;
   tree ifbody;
-  tree cond;
   gfc_loopinfo loop;
   gfc_actual_arglist *actual;
   gfc_ss *arrayss;
@@ -1744,17 +1743,10 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 
   gcc_assert (loop.dimen == 1);
 
-  /* Initialize the position to the first element.  If the array has zero
-     size we need to return zero.  Otherwise use the first element of the
-     array, in case all elements are equal to the limit.
-     i.e. pos = (ubound >= lbound) ? lbound, lbound - 1;  */
-  tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
-		     loop.from[0], gfc_index_one_node);
-  cond = fold_build2 (GE_EXPR, boolean_type_node,
-		      loop.to[0], loop.from[0]);
-  tmp = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
-		     loop.from[0], tmp);
-  gfc_add_modify_expr (&loop.pre, pos, tmp);
+  /* Initialize the position to zero, following Fortran 2003.  We are free
+     to do this because Fortran 95 allows the result of an entirely false
+     mask to be processor dependent.  */
+  gfc_add_modify_expr (&loop.pre, pos, gfc_index_zero_node);
 
   gfc_mark_ss_chain_used (arrayss, 1);
   if (maskss)
@@ -1794,8 +1786,10 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 
   ifbody = gfc_finish_block (&ifblock);
 
-  /* If it is a more extreme value.  */
-  tmp = build2 (op, boolean_type_node, arrayse.expr, limit);
+  /* If it is a more extreme value or pos is still zero.  */
+  tmp = build2 (TRUTH_OR_EXPR, boolean_type_node,
+		  build2 (op, boolean_type_node, arrayse.expr, limit),
+		  build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node));
   tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
   gfc_add_expr_to_block (&block, tmp);
 
@@ -1826,14 +1820,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 	 the pos variable the same way as above.  */
 
       gfc_init_block (&elseblock);
-
-      elsetmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
-			     loop.from[0], gfc_index_one_node);
-      cond = fold_build2 (GE_EXPR, boolean_type_node,
-			  loop.to[0], loop.from[0]);
-      elsetmp = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
-			  loop.from[0], elsetmp);
-      gfc_add_modify_expr (&elseblock, pos, elsetmp);
+      gfc_add_modify_expr (&elseblock, pos, gfc_index_zero_node);
       elsetmp = gfc_finish_block (&elseblock);
 
       tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b47252a..f049f46 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-03-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25378
+	* gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90: Expand test to include more
+	permuatations of mask and index.
+	* testsuite/gfortran.dg/scalar_mask_1.f90: Modify last test to respond to F2003 spec.
+	that the position returned for an all false mask && condition is zero.
+
 2006-03-13  Jakub Jelinek  <jakub@redhat.com>
 
 	PR middle-end/25989
diff --git a/gcc/testsuite/gfortran.dg/scalar_mask_1.f90 b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
index 01bef2c..e2e5d6c 100644
--- a/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
+++ b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
@@ -11,5 +11,5 @@ program main
   if (maxval (a, .true.) /= 3.0) call abort
   if (maxval (a, .false.) > -1e38) call abort
   if (maxloc (a, 1, .true.) /= 2) call abort
-  if (maxloc (a, 1, .false.) /= 1) call abort
+  if (maxloc (a, 1, .false.) /= 0) call abort ! Change to F2003 requirement.
 end program main
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90
index 2e18a29..078a08d 100644
--- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90
@@ -3,10 +3,38 @@
 program intrinsic_mmloc_3
   integer, dimension(2) :: d
   integer, dimension(2,2) :: a
+  logical, dimension(2) :: k
+  logical, dimension(2,2) :: l
+
+  k = .true.
+  l = .true.
+
+  d = -huge (d)
+  if (maxloc (d, 1) .ne. 1) call abort ()
+
+  d = huge (d)
+  if (minloc (d, 1) .ne. 1) call abort ()
 
   d = -huge (d)
-  if (maxloc (d, 1) .ne. 1) call abort()
+  if (maxloc (d, 1, k) .ne. 1) call abort ()
+
+  d = huge (d)
+  if (minloc (d, 1, k) .ne. 1) call abort ()
+
+  a = -huge (a)
+  d = maxloc (a)
+  if (any (d .ne. 1)) call abort ()
+
   a = huge (a)
   d = minloc (a)
-  if (any (d .ne. 1)) call abort()
+  if (any (d .ne. 1)) call abort ()
+
+  a = -huge (a)
+  d = maxloc (a, l)
+  if (any (d .ne. 1)) call abort ()
+
+  a = huge (a)
+  d = minloc (a, l)
+  if (any (d .ne. 1)) call abort ()
+
 end program