PR fortran/40643

	PR fortran/31067
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc,
	gfc_conv_intrinsic_minmaxval): Handle Infinities and NaNs properly,
	optimize.
	* trans-array.c (gfc_trans_scalarized_loop_end): No longer static.
	* trans-array.h (gfc_trans_scalarized_loop_end): New prototype.

	* libgfortran.h (GFC_REAL_4_INFINITY, GFC_REAL_8_INFINITY,
	GFC_REAL_10_INFINITY, GFC_REAL_16_INFINITY, GFC_REAL_4_QUIET_NAN,
	GFC_REAL_8_QUIET_NAN, GFC_REAL_10_QUIET_NAN, GFC_REAL_16_QUIET_NAN):
	Define.
	* m4/iparm.m4 (atype_inf, atype_nan): Define.
	* m4/ifunction.m4: Formatting.
	* m4/iforeach.m4: Likewise.
	(START_FOREACH_FUNCTION): Initialize dest to all 1s, not all 0s.
	(START_FOREACH_BLOCK, FINISH_FOREACH_FUNCTION,
	FINISH_MASKED_FOREACH_FUNCTION): Run foreach block inside a loop
	until count[0] == extent[0].
	* m4/minval.m4: Formatting.  Handle NaNs and infinities.  Optimize.
	* m4/maxval.m4: Likewise.
	* m4/minloc0.m4: Likewise.
	* m4/maxloc0.m4: Likewise.
	* m4/minloc1.m4: Likewise.
	* m4/maxloc1.m4: Likewise.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i1.c: Likewise.
	* generated/maxloc0_16_i2.c: Likewise.
	* generated/maxloc0_16_i4.c: Likewise.
	* generated/maxloc0_16_i8.c: Likewise.
	* generated/maxloc0_16_r10.c: Likewise.
	* generated/maxloc0_16_r16.c: Likewise.
	* generated/maxloc0_16_r4.c: Likewise.
	* generated/maxloc0_16_r8.c: Likewise.
	* generated/maxloc0_4_i16.c: Likewise.
	* generated/maxloc0_4_i1.c: Likewise.
	* generated/maxloc0_4_i2.c: Likewise.
	* generated/maxloc0_4_i4.c: Likewise.
	* generated/maxloc0_4_i8.c: Likewise.
	* generated/maxloc0_4_r10.c: Likewise.
	* generated/maxloc0_4_r16.c: Likewise.
	* generated/maxloc0_4_r4.c: Likewise.
	* generated/maxloc0_4_r8.c: Likewise.
	* generated/maxloc0_8_i16.c: Likewise.
	* generated/maxloc0_8_i1.c: Likewise.
	* generated/maxloc0_8_i2.c: Likewise.
	* generated/maxloc0_8_i4.c: Likewise.
	* generated/maxloc0_8_i8.c: Likewise.
	* generated/maxloc0_8_r10.c: Likewise.
	* generated/maxloc0_8_r16.c: Likewise.
	* generated/maxloc0_8_r4.c: Likewise.
	* generated/maxloc0_8_r8.c: Likewise.
	* generated/maxloc1_16_i16.c: Likewise.
	* generated/maxloc1_16_i1.c: Likewise.
	* generated/maxloc1_16_i2.c: Likewise.
	* generated/maxloc1_16_i4.c: Likewise.
	* generated/maxloc1_16_i8.c: Likewise.
	* generated/maxloc1_16_r10.c: Likewise.
	* generated/maxloc1_16_r16.c: Likewise.
	* generated/maxloc1_16_r4.c: Likewise.
	* generated/maxloc1_16_r8.c: Likewise.
	* generated/maxloc1_4_i16.c: Likewise.
	* generated/maxloc1_4_i1.c: Likewise.
	* generated/maxloc1_4_i2.c: Likewise.
	* generated/maxloc1_4_i4.c: Likewise.
	* generated/maxloc1_4_i8.c: Likewise.
	* generated/maxloc1_4_r10.c: Likewise.
	* generated/maxloc1_4_r16.c: Likewise.
	* generated/maxloc1_4_r4.c: Likewise.
	* generated/maxloc1_4_r8.c: Likewise.
	* generated/maxloc1_8_i16.c: Likewise.
	* generated/maxloc1_8_i1.c: Likewise.
	* generated/maxloc1_8_i2.c: Likewise.
	* generated/maxloc1_8_i4.c: Likewise.
	* generated/maxloc1_8_i8.c: Likewise.
	* generated/maxloc1_8_r10.c: Likewise.
	* generated/maxloc1_8_r16.c: Likewise.
	* generated/maxloc1_8_r4.c: Likewise.
	* generated/maxloc1_8_r8.c: Likewise.
	* generated/maxval_i16.c: Likewise.
	* generated/maxval_i1.c: Likewise.
	* generated/maxval_i2.c: Likewise.
	* generated/maxval_i4.c: Likewise.
	* generated/maxval_i8.c: Likewise.
	* generated/maxval_r10.c: Likewise.
	* generated/maxval_r16.c: Likewise.
	* generated/maxval_r4.c: Likewise.
	* generated/maxval_r8.c: Likewise.
	* generated/minloc0_16_i16.c: Likewise.
	* generated/minloc0_16_i1.c: Likewise.
	* generated/minloc0_16_i2.c: Likewise.
	* generated/minloc0_16_i4.c: Likewise.
	* generated/minloc0_16_i8.c: Likewise.
	* generated/minloc0_16_r10.c: Likewise.
	* generated/minloc0_16_r16.c: Likewise.
	* generated/minloc0_16_r4.c: Likewise.
	* generated/minloc0_16_r8.c: Likewise.
	* generated/minloc0_4_i16.c: Likewise.
	* generated/minloc0_4_i1.c: Likewise.
	* generated/minloc0_4_i2.c: Likewise.
	* generated/minloc0_4_i4.c: Likewise.
	* generated/minloc0_4_i8.c: Likewise.
	* generated/minloc0_4_r10.c: Likewise.
	* generated/minloc0_4_r16.c: Likewise.
	* generated/minloc0_4_r4.c: Likewise.
	* generated/minloc0_4_r8.c: Likewise.
	* generated/minloc0_8_i16.c: Likewise.
	* generated/minloc0_8_i1.c: Likewise.
	* generated/minloc0_8_i2.c: Likewise.
	* generated/minloc0_8_i4.c: Likewise.
	* generated/minloc0_8_i8.c: Likewise.
	* generated/minloc0_8_r10.c: Likewise.
	* generated/minloc0_8_r16.c: Likewise.
	* generated/minloc0_8_r4.c: Likewise.
	* generated/minloc0_8_r8.c: Likewise.
	* generated/minloc1_16_i16.c: Likewise.
	* generated/minloc1_16_i1.c: Likewise.
	* generated/minloc1_16_i2.c: Likewise.
	* generated/minloc1_16_i4.c: Likewise.
	* generated/minloc1_16_i8.c: Likewise.
	* generated/minloc1_16_r10.c: Likewise.
	* generated/minloc1_16_r16.c: Likewise.
	* generated/minloc1_16_r4.c: Likewise.
	* generated/minloc1_16_r8.c: Likewise.
	* generated/minloc1_4_i16.c: Likewise.
	* generated/minloc1_4_i1.c: Likewise.
	* generated/minloc1_4_i2.c: Likewise.
	* generated/minloc1_4_i4.c: Likewise.
	* generated/minloc1_4_i8.c: Likewise.
	* generated/minloc1_4_r10.c: Likewise.
	* generated/minloc1_4_r16.c: Likewise.
	* generated/minloc1_4_r4.c: Likewise.
	* generated/minloc1_4_r8.c: Likewise.
	* generated/minloc1_8_i16.c: Likewise.
	* generated/minloc1_8_i1.c: Likewise.
	* generated/minloc1_8_i2.c: Likewise.
	* generated/minloc1_8_i4.c: Likewise.
	* generated/minloc1_8_i8.c: Likewise.
	* generated/minloc1_8_r10.c: Likewise.
	* generated/minloc1_8_r16.c: Likewise.
	* generated/minloc1_8_r4.c: Likewise.
	* generated/minloc1_8_r8.c: Likewise.
	* generated/minval_i16.c: Likewise.
	* generated/minval_i1.c: Likewise.
	* generated/minval_i2.c: Likewise.
	* generated/minval_i4.c: Likewise.
	* generated/minval_i8.c: Likewise.
	* generated/minval_r10.c: Likewise.
	* generated/minval_r16.c: Likewise.
	* generated/minval_r4.c: Likewise.
	* generated/minval_r8.c: Likewise.
	* generated/product_c10.c: Likewise.
	* generated/product_c16.c: Likewise.
	* generated/product_c4.c: Likewise.
	* generated/product_c8.c: Likewise.
	* generated/product_i16.c: Likewise.
	* generated/product_i1.c: Likewise.
	* generated/product_i2.c: Likewise.
	* generated/product_i4.c: Likewise.
	* generated/product_i8.c: Likewise.
	* generated/product_r10.c: Likewise.
	* generated/product_r16.c: Likewise.
	* generated/product_r4.c: Likewise.
	* generated/product_r8.c: Likewise.
	* generated/sum_c10.c: Likewise.
	* generated/sum_c16.c: Likewise.
	* generated/sum_c4.c: Likewise.
	* generated/sum_c8.c: Likewise.
	* generated/sum_i16.c: Likewise.
	* generated/sum_i1.c: Likewise.
	* generated/sum_i2.c: Likewise.
	* generated/sum_i4.c: Likewise.
	* generated/sum_i8.c: Likewise.
	* generated/sum_r10.c: Likewise.
	* generated/sum_r16.c: Likewise.
	* generated/sum_r4.c: Likewise.
	* generated/sum_r8.c: Likewise.

	* gfortran.dg/maxlocval_2.f90: New test.
	* gfortran.dg/maxlocval_3.f90: New test.
	* gfortran.dg/maxlocval_4.f90: New test.
	* gfortran.dg/minlocval_1.f90: New test.
	* gfortran.dg/minlocval_2.f90: New test.
	* gfortran.dg/minlocval_3.f90: New test.
	* gfortran.dg/minlocval_4.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150041 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 141 insertions, 98 deletions

diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c
index 83d84c58ef1..d392bee6b65 100644
--- a/libgfortran/generated/maxloc1_8_r16.c
+++ b/libgfortran/generated/maxloc1_8_r16.c
@@ -85,15 +85,15 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       size_t alloc_size, str;
 
       for (n = 0; n < rank; n++)
-        {
-          if (n == 0)
+	{
+	  if (n == 0)
 	    str = 1;
-          else
-            str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+	  else
+	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
 
 	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
 
-        }
+	}
 
       retarray->offset = 0;
       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
@@ -129,7 +129,7 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       count[n] = 0;
       dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
       if (extent[n] <= 0)
-        len = 0;
+	len = 0;
     }
 
   base = array->data;
@@ -143,22 +143,37 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       src = base;
       {
 
-  GFC_REAL_16 maxval;
-  maxval = -GFC_REAL_16_HUGE;
-  result = 0;
-        if (len <= 0)
+	GFC_REAL_16 maxval;
+#if defined (GFC_REAL_16_INFINITY)
+	maxval = -GFC_REAL_16_INFINITY;
+#else
+	maxval = -GFC_REAL_16_HUGE;
+#endif
+	result = 1;
+	if (len <= 0)
 	  *dest = 0;
 	else
 	  {
 	    for (n = 0; n < len; n++, src += delta)
 	      {
 
-  if (*src > maxval || !result)
-    {
-      maxval = *src;
-      result = (GFC_INTEGER_8)n + 1;
-    }
-          }
+#if defined (GFC_REAL_16_QUIET_NAN)
+		if (*src >= maxval)
+		  {
+		    maxval = *src;
+		    result = (GFC_INTEGER_8)n + 1;
+		    break;
+		  }
+	      }
+	    for (; n < len; n++, src += delta)
+	      {
+#endif
+		if (*src > maxval)
+		  {
+		    maxval = *src;
+		    result = (GFC_INTEGER_8)n + 1;
+		  }
+	      }
 	    *dest = result;
 	  }
       }
@@ -168,28 +183,28 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       dest += dstride[0];
       n = 0;
       while (count[n] == extent[n])
-        {
-          /* When we get to the end of a dimension, reset it and increment
-             the next dimension.  */
-          count[n] = 0;
-          /* We could precalculate these products, but this is a less
-             frequently used path so probably not worth it.  */
-          base -= sstride[n] * extent[n];
-          dest -= dstride[n] * extent[n];
-          n++;
-          if (n == rank)
-            {
-              /* Break out of the look.  */
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  dest -= dstride[n] * extent[n];
+	  n++;
+	  if (n == rank)
+	    {
+	      /* Break out of the look.  */
 	      continue_loop = 0;
 	      break;
-            }
-          else
-            {
-              count[n]++;
-              base += sstride[n];
-              dest += dstride[n];
-            }
-        }
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      dest += dstride[n];
+	    }
+	}
     }
 }
 
@@ -269,15 +284,15 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       size_t alloc_size, str;
 
       for (n = 0; n < rank; n++)
-        {
-          if (n == 0)
-            str = 1;
-          else
-            str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+	{
+	  if (n == 0)
+	    str = 1;
+	  else
+	    str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
 
 	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
 
-        }
+	}
 
       alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
     		   * extent[rank-1];
@@ -314,7 +329,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       count[n] = 0;
       dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
       if (extent[n] <= 0)
-        return;
+	return;
     }
 
   dest = retarray->data;
@@ -329,22 +344,50 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       msrc = mbase;
       {
 
-  GFC_REAL_16 maxval;
-  maxval = -GFC_REAL_16_HUGE;
-  result = 0;
-        if (len <= 0)
+	GFC_REAL_16 maxval;
+#if defined (GFC_REAL_16_INFINITY)
+	maxval = -GFC_REAL_16_INFINITY;
+#else
+	maxval = -GFC_REAL_16_HUGE;
+#endif
+#if defined (GFC_REAL_16_QUIET_NAN)
+	GFC_INTEGER_8 result2 = 0;
+#endif
+	result = 0;
+	if (len <= 0)
 	  *dest = 0;
 	else
 	  {
 	    for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 	      {
 
-  if (*msrc && (*src > maxval || !result))
-    {
-      maxval = *src;
-      result = (GFC_INTEGER_8)n + 1;
-    }
-              }
+		if (*msrc)
+		  {
+#if defined (GFC_REAL_16_QUIET_NAN)
+		    if (!result2)
+		      result2 = (GFC_INTEGER_8)n + 1;
+		    if (*src >= maxval)
+#endif
+		      {
+			maxval = *src;
+			result = (GFC_INTEGER_8)n + 1;
+			break;
+		      }
+		  }
+	      }
+#if defined (GFC_REAL_16_QUIET_NAN)
+	    if (unlikely (n >= len))
+	      result = result2;
+	    else
+#endif
+	    for (; n < len; n++, src += delta, msrc += mdelta)
+	      {
+		if (*msrc && *src > maxval)
+		  {
+		    maxval = *src;
+		    result = (GFC_INTEGER_8)n + 1;
+		  }
+	      }
 	    *dest = result;
 	  }
       }
@@ -355,30 +398,30 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       dest += dstride[0];
       n = 0;
       while (count[n] == extent[n])
-        {
-          /* When we get to the end of a dimension, reset it and increment
-             the next dimension.  */
-          count[n] = 0;
-          /* We could precalculate these products, but this is a less
-             frequently used path so probably not worth it.  */
-          base -= sstride[n] * extent[n];
-          mbase -= mstride[n] * extent[n];
-          dest -= dstride[n] * extent[n];
-          n++;
-          if (n == rank)
-            {
-              /* Break out of the look.  */
-              base = NULL;
-              break;
-            }
-          else
-            {
-              count[n]++;
-              base += sstride[n];
-              mbase += mstride[n];
-              dest += dstride[n];
-            }
-        }
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  dest -= dstride[n] * extent[n];
+	  n++;
+	  if (n == rank)
+	    {
+	      /* Break out of the look.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	      dest += dstride[n];
+	    }
+	}
     }
 }
 
@@ -426,10 +469,10 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
     {
       sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
       extent[n] =
-        GFC_DESCRIPTOR_EXTENT(array,n + 1);
+	GFC_DESCRIPTOR_EXTENT(array,n + 1);
 
       if (extent[n] <= 0)
-        extent[n] = 0;
+	extent[n] = 0;
     }
 
   if (retarray->data == NULL)
@@ -437,15 +480,15 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       size_t alloc_size, str;
 
       for (n = 0; n < rank; n++)
-        {
-          if (n == 0)
-            str = 1;
-          else
-            str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+	{
+	  if (n == 0)
+	    str = 1;
+	  else
+	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
 
 	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
 
-        }
+	}
 
       retarray->offset = 0;
       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
@@ -501,21 +544,21 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
       dest += dstride[0];
       n = 0;
       while (count[n] == extent[n])
-        {
+	{
 	  /* When we get to the end of a dimension, reset it and increment
-             the next dimension.  */
-          count[n] = 0;
-          /* We could precalculate these products, but this is a less
-             frequently used path so probably not worth it.  */
-          dest -= dstride[n] * extent[n];
-          n++;
-          if (n == rank)
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  dest -= dstride[n] * extent[n];
+	  n++;
+	  if (n == rank)
 	    return;
-          else
-            {
-              count[n]++;
-              dest += dstride[n];
-            }
+	  else
+	    {
+	      count[n]++;
+	      dest += dstride[n];
+	    }
       	}
     }
 }