re PR fortran/37836 (ICE in gfc_trans_auto_array_allocation)

2008-11-09  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/37836
        * intrinsic.c (add_functions): Reference gfc_simplify._minval
	and gfc_simplify_maxval.
	* intrinsic.h : Add prototypes for gfc_simplify._minval and
	gfc_simplify_maxval.
	* simplify.c (min_max_choose): New function extracted from
	simplify_min_max.
	(simplify_min_max): Call it.
	(simplify_minval_maxval, gfc_simplify_minval,
	gfc_simplify_maxval): New functions.

2008-11-09  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/37836
        * gfortran.dg/minmaxval_1.f90: New test.

From-SVN: r141717

gcc/fortran/ChangeLog

+2008-11-09  Paul Thomas  <pault@gcc.gnu.org>
+
+        PR fortran/37836
+        * intrinsic.c (add_functions): Reference gfc_simplify._minval
+	and gfc_simplify_maxval.
+	* intrinsic.h : Add prototypes for gfc_simplify._minval and
+	gfc_simplify_maxval.
+	* simplify.c (min_max_choose): New function extracted from
+	simplify_min_max.
+	(simplify_min_max): Call it.
+	(simplify_minval_maxval, gfc_simplify_minval,
+	gfc_simplify_maxval): New functions.
+
 2008-11-04  Paul Thomas  <pault@gcc.gnu.org>
 
         PR fortran/37597

gcc/fortran/intrinsic.c

@@ -1957,7 +1957,7 @@ add_functions (void)
   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
 
   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
-		gfc_check_minval_maxval, NULL, gfc_resolve_maxval,
+		gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
 		msk, BT_LOGICAL, dl, OPTIONAL);
 
@@ -2023,7 +2023,7 @@ add_functions (void)
   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
 
   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
-		gfc_check_minval_maxval, NULL, gfc_resolve_minval,
+		gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
 		msk, BT_LOGICAL, dl, OPTIONAL);
 

gcc/fortran/intrinsic.h

@@ -271,7 +271,9 @@ gfc_expr *gfc_simplify_log (gfc_expr *);
 gfc_expr *gfc_simplify_log10 (gfc_expr *);
 gfc_expr *gfc_simplify_logical (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_min (gfc_expr *);
+gfc_expr *gfc_simplify_minval (gfc_expr *, gfc_expr*, gfc_expr*);
 gfc_expr *gfc_simplify_max (gfc_expr *);
+gfc_expr *gfc_simplify_maxval (gfc_expr *, gfc_expr*, gfc_expr*);
 gfc_expr *gfc_simplify_maxexponent (gfc_expr *);
 gfc_expr *gfc_simplify_minexponent (gfc_expr *);
 gfc_expr *gfc_simplify_mod (gfc_expr *, gfc_expr *);

gcc/fortran/simplify.c

@@ -2619,57 +2619,32 @@ gfc_simplify_logical (gfc_expr *e, gfc_expr *k)
 }
 
 
-/* This function is special since MAX() can take any number of
-   arguments.  The simplified expression is a rewritten version of the
-   argument list containing at most one constant element.  Other
-   constant elements are deleted.  Because the argument list has
-   already been checked, this function always succeeds.  sign is 1 for
-   MAX(), -1 for MIN().  */
-
-static gfc_expr *
-simplify_min_max (gfc_expr *expr, int sign)
+/* Selects bewteen current value and extremum for simplify_min_max
+   and simplify_minval_maxval.  */
+static void
+min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
 {
-  gfc_actual_arglist *arg, *last, *extremum;
-  gfc_intrinsic_sym * specific;
-
-  last = NULL;
-  extremum = NULL;
-  specific = expr->value.function.isym;
-
-  arg = expr->value.function.actual;
-
-  for (; arg; last = arg, arg = arg->next)
-    {
-      if (arg->expr->expr_type != EXPR_CONSTANT)
-	continue;
-
-      if (extremum == NULL)
-	{
-	  extremum = arg;
-	  continue;
-	}
-
-      switch (arg->expr->ts.type)
+  switch (arg->ts.type)
     {
       case BT_INTEGER:
-	  if (mpz_cmp (arg->expr->value.integer,
-		       extremum->expr->value.integer) * sign > 0)
-	    mpz_set (extremum->expr->value.integer, arg->expr->value.integer);
+	if (mpz_cmp (arg->value.integer,
+			extremum->value.integer) * sign > 0)
+	mpz_set (extremum->value.integer, arg->value.integer);
 	break;
 
       case BT_REAL:
 	/* We need to use mpfr_min and mpfr_max to treat NaN properly.  */
 	if (sign > 0)
-	    mpfr_max (extremum->expr->value.real, extremum->expr->value.real,
-		      arg->expr->value.real, GFC_RND_MODE);
+	  mpfr_max (extremum->value.real, extremum->value.real,
+		      arg->value.real, GFC_RND_MODE);
 	else
-	    mpfr_min (extremum->expr->value.real, extremum->expr->value.real,
-		      arg->expr->value.real, GFC_RND_MODE);
+	  mpfr_min (extremum->value.real, extremum->value.real,
+		      arg->value.real, GFC_RND_MODE);
 	break;
 
       case BT_CHARACTER:
-#define LENGTH(x) ((x)->expr->value.character.length)
-#define STRING(x) ((x)->expr->value.character.string)
+#define LENGTH(x) ((x)->value.character.length)
+#define STRING(x) ((x)->value.character.string)
 	if (LENGTH(extremum) < LENGTH(arg))
 	  {
 	    gfc_char_t *tmp = STRING(extremum);
@@ -2684,7 +2659,7 @@ simplify_min_max (gfc_expr *expr, int sign)
 	    gfc_free (tmp);
 	  }
 
-	  if (gfc_compare_string (arg->expr, extremum->expr) * sign > 0)
+	if (gfc_compare_string (arg, extremum) * sign > 0)
 	  {
 	    gfc_free (STRING(extremum));
 	    STRING(extremum) = gfc_get_wide_string (LENGTH(extremum) + 1);
@@ -2698,10 +2673,43 @@ simplify_min_max (gfc_expr *expr, int sign)
 #undef STRING
 	break;
 	      
-
       default:
 	gfc_internal_error ("simplify_min_max(): Bad type in arglist");
     }
+}
+
+
+/* This function is special since MAX() can take any number of
+   arguments.  The simplified expression is a rewritten version of the
+   argument list containing at most one constant element.  Other
+   constant elements are deleted.  Because the argument list has
+   already been checked, this function always succeeds.  sign is 1 for
+   MAX(), -1 for MIN().  */
+
+static gfc_expr *
+simplify_min_max (gfc_expr *expr, int sign)
+{
+  gfc_actual_arglist *arg, *last, *extremum;
+  gfc_intrinsic_sym * specific;
+
+  last = NULL;
+  extremum = NULL;
+  specific = expr->value.function.isym;
+
+  arg = expr->value.function.actual;
+
+  for (; arg; last = arg, arg = arg->next)
+    {
+      if (arg->expr->expr_type != EXPR_CONSTANT)
+	continue;
+
+      if (extremum == NULL)
+	{
+	  extremum = arg;
+	  continue;
+	}
+
+      min_max_choose (arg->expr, extremum->expr, sign);
 
       /* Delete the extra constant argument.  */
       if (last == NULL)
@@ -2746,6 +2754,69 @@ gfc_simplify_max (gfc_expr *e)
 }
 
 
+/* This is a simplified version of simplify_min_max to provide
+   simplification of minval and maxval for a vector.  */
+
+static gfc_expr *
+simplify_minval_maxval (gfc_expr *expr, int sign)
+{
+  gfc_constructor *ctr, *extremum;
+  gfc_intrinsic_sym * specific;
+
+  extremum = NULL;
+  specific = expr->value.function.isym;
+
+  ctr = expr->value.constructor;
+
+  for (; ctr; ctr = ctr->next)
+    {
+      if (ctr->expr->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      if (extremum == NULL)
+	{
+	  extremum = ctr;
+	  continue;
+	}
+
+      min_max_choose (ctr->expr, extremum->expr, sign);
+     }
+
+  if (extremum == NULL)
+    return NULL;
+
+  /* Convert to the correct type and kind.  */
+  if (expr->ts.type != BT_UNKNOWN) 
+    return gfc_convert_constant (extremum->expr,
+	expr->ts.type, expr->ts.kind);
+
+  if (specific->ts.type != BT_UNKNOWN) 
+    return gfc_convert_constant (extremum->expr,
+	specific->ts.type, specific->ts.kind); 
+ 
+  return gfc_copy_expr (extremum->expr);
+}
+
+
+gfc_expr *
+gfc_simplify_minval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
+{
+  if (array->expr_type != EXPR_ARRAY || array->rank != 1 || dim || mask)
+    return NULL;
+  
+  return simplify_minval_maxval (array, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_maxval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
+{
+  if (array->expr_type != EXPR_ARRAY || array->rank != 1 || dim || mask)
+    return NULL;
+  return simplify_minval_maxval (array, 1);
+}
+
+
 gfc_expr *
 gfc_simplify_maxexponent (gfc_expr *x)
 {

gcc/testsuite/ChangeLog

+2008-11-09  Paul Thomas  <pault@gcc.gnu.org>
+
+        PR fortran/37836
+        * gfortran.dg/minmaxval_1.f90: New test.
+
 2008-11-09  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/loop_boolean.adb: New test.

gcc/testsuite/gfortran.dg/minmaxval_1.f90

+! { dg-do compile }
+! Tests the fix for PR37836 in which the specification expressions for
+! y were not simplified because there was no simplifier for minval and
+! maxval.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+! nint(exp(3.0)) is equal to 20 :-)
+!
+      function fun4a()
+         integer fun4a
+         real y(minval([25, nint(exp(3.0)), 15]))
+
+        fun4a = size (y, 1)
+       end function fun4a
+
+      function fun4b()
+         integer fun4b
+         real y(maxval([25, nint(exp(3.0)), 15]))
+         save
+
+         fun4b = size (y, 1)
+      end function fun4b
+
+      EXTERNAL fun4a, fun4b
+      integer fun4a, fun4b
+      if (fun4a () .ne. 15) call abort 
+      if (fun4b () .ne. 25) call abort 
+      end