re PR fortran/29828 ([F2003] MIN and MAX with character variables)

	PR fortran/29828

	* trans.h (gfor_fndecl_string_minmax): New prototype.
	* trans-decl.c (gfor_fndecl_string_minmax): New variable.
	(gfc_build_intrinsic_function_decls): Create gfor_fndecl_string_minmax.
	* check.c (gfc_check_min_max): Allow for character arguments.
	* trans-intrinsic.c (gfc_conv_intrinsic_minmax_char): New function.
	(gfc_conv_intrinsic_function): Add special case for MIN and MAX
	intrinsics with character arguments.
	* simplify.c (simplify_min_max): Add simplification for character
	arguments.

	* intrinsics/string_intrinsics.c (string_minmax): New function
	and prototype.
	* gfortran.map (GFORTRAN_1.0): Add _gfortran_string_minmax

	* gfortran.dg/minmax_char_1.f90: New test.
	* gfortran.dg/minmax_char_2.f90: New test.
	* gfortran.dg/min_max_optional_4.f90: New test.

From-SVN: r127252

6 files changed, 109 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cc3b89b..2bd347e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,18 @@
 2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+	PR fortran/29828
+	* trans.h (gfor_fndecl_string_minmax): New prototype.
+	* trans-decl.c (gfor_fndecl_string_minmax): New variable.
+	(gfc_build_intrinsic_function_decls): Create gfor_fndecl_string_minmax.
+	* check.c (gfc_check_min_max): Allow for character arguments.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax_char): New function.
+	(gfc_conv_intrinsic_function): Add special case for MIN and MAX
+	intrinsics with character arguments.
+	* simplify.c (simplify_min_max): Add simplification for character
+	arguments.
+
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
 	PR fortran/31612
 	* invoke.texi: Adjust documentation for option -fsyntax-only.
 
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index e792773..ba72aaa 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1512,10 +1512,17 @@ gfc_check_min_max (gfc_actual_arglist *arg)
 
   x = arg->expr;
 
-  if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+  if (x->ts.type == BT_CHARACTER)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			  "with CHARACTER argument at %L",
+			  gfc_current_intrinsic, &x->where) == FAILURE)
+	return FAILURE;
+    }
+  else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
     {
-      gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER "
-		 "or REAL", gfc_current_intrinsic, &x->where);
+      gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER, "
+		 "REAL or CHARACTER", gfc_current_intrinsic, &x->where);
       return FAILURE;
     }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7919dae..88a146b 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2361,7 +2361,6 @@ simplify_min_max (gfc_expr *expr, int sign)
 	  if (mpz_cmp (arg->expr->value.integer,
 		       extremum->expr->value.integer) * sign > 0)
 	    mpz_set (extremum->expr->value.integer, arg->expr->value.integer);
-
 	  break;
 
 	case BT_REAL:
@@ -2369,11 +2368,40 @@ simplify_min_max (gfc_expr *expr, int sign)
 	      * sign > 0)
 	    mpfr_set (extremum->expr->value.real, arg->expr->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)
+	  if (LENGTH(extremum) < LENGTH(arg))
+	    {
+	      char * tmp = STRING(extremum);
+
+	      STRING(extremum) = gfc_getmem (LENGTH(arg) + 1);
+	      memcpy (STRING(extremum), tmp, LENGTH(extremum));
+	      memset (&STRING(extremum)[LENGTH(extremum)], ' ',
+		      LENGTH(arg) - LENGTH(extremum));
+	      STRING(extremum)[LENGTH(arg)] = '\0';  /* For debugger  */
+	      LENGTH(extremum) = LENGTH(arg);
+	      gfc_free (tmp);
+	    }
 
+	  if (gfc_compare_string (arg->expr, extremum->expr) * sign > 0)
+	    {
+	      gfc_free (STRING(extremum));
+	      STRING(extremum) = gfc_getmem (LENGTH(extremum) + 1);
+	      memcpy (STRING(extremum), STRING(arg), LENGTH(arg));
+	      memset (&STRING(extremum)[LENGTH(arg)], ' ',
+		      LENGTH(extremum) - LENGTH(arg));
+	      STRING(extremum)[LENGTH(extremum)] = '\0';  /* For debugger  */
+	    }
+#undef LENGTH
+#undef STRING
 	  break;
+	      
 
 	default:
-	  gfc_internal_error ("gfc_simplify_max(): Bad type in arglist");
+	  gfc_internal_error ("simplify_min_max(): Bad type in arglist");
 	}
 
       /* Delete the extra constant argument.  */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b74b466..c9a195f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -125,6 +125,7 @@ tree gfor_fndecl_string_index;
 tree gfor_fndecl_string_scan;
 tree gfor_fndecl_string_verify;
 tree gfor_fndecl_string_trim;
+tree gfor_fndecl_string_minmax;
 tree gfor_fndecl_adjustl;
 tree gfor_fndecl_adjustr;
 
@@ -2047,6 +2048,13 @@ gfc_build_intrinsic_function_decls (void)
                                      gfc_charlen_type_node,
                                      pchar_type_node);
 
+  gfor_fndecl_string_minmax = 
+    gfc_build_library_function_decl (get_identifier (PREFIX("string_minmax")),
+                                     void_type_node, -4,
+                                     build_pointer_type (gfc_charlen_type_node),
+                                     ppvoid_type_node, integer_type_node,
+                                     integer_type_node);
+
   gfor_fndecl_ttynam =
     gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")),
                                      void_type_node,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index dcdc3c7..ce6b585 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1561,6 +1561,45 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
 }
 
 
+/* Generate library calls for MIN and MAX intrinsics for character
+   variables.  */
+static void
+gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
+{
+  tree *args;
+  tree var, len, fndecl, tmp, cond;
+  unsigned int nargs;
+
+  nargs = gfc_intrinsic_argument_list_length (expr);
+  args = alloca (sizeof (tree) * (nargs + 4));
+  gfc_conv_intrinsic_function_args (se, expr, &args[4], nargs);
+
+  /* Create the result variables.  */
+  len = gfc_create_var (gfc_charlen_type_node, "len");
+  args[0] = build_fold_addr_expr (len);
+  var = gfc_create_var (build_pointer_type (gfc_character1_type_node), "pstr");
+  args[1] = gfc_build_addr_expr (ppvoid_type_node, var);
+  args[2] = build_int_cst (NULL_TREE, op);
+  args[3] = build_int_cst (NULL_TREE, nargs / 2);
+
+  /* Make the function call.  */
+  fndecl = build_addr (gfor_fndecl_string_minmax, current_function_decl);
+  tmp = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_minmax)),
+			  fndecl, nargs + 4, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = build2 (GT_EXPR, boolean_type_node, len,
+		 build_int_cst (TREE_TYPE (len), 0));
+  tmp = gfc_call_free (var);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
 /* Create a symbol node for this intrinsic.  The symbol from the frontend
    has the generic name.  */
 
@@ -4058,7 +4097,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_MAX:
-      gfc_conv_intrinsic_minmax (se, expr, GT_EXPR);
+      if (expr->ts.type == BT_CHARACTER)
+	gfc_conv_intrinsic_minmax_char (se, expr, 1);
+      else
+	gfc_conv_intrinsic_minmax (se, expr, GT_EXPR);
       break;
 
     case GFC_ISYM_MAXLOC:
@@ -4074,7 +4116,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_MIN:
-      gfc_conv_intrinsic_minmax (se, expr, LT_EXPR);
+      if (expr->ts.type == BT_CHARACTER)
+	gfc_conv_intrinsic_minmax_char (se, expr, -1);
+      else
+	gfc_conv_intrinsic_minmax (se, expr, LT_EXPR);
       break;
 
     case GFC_ISYM_MINLOC:
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 5ad3ca6..8226187 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -540,6 +540,7 @@ extern GTY(()) tree gfor_fndecl_string_index;
 extern GTY(()) tree gfor_fndecl_string_scan;
 extern GTY(()) tree gfor_fndecl_string_verify;
 extern GTY(()) tree gfor_fndecl_string_trim;
+extern GTY(()) tree gfor_fndecl_string_minmax;
 extern GTY(()) tree gfor_fndecl_adjustl;
 extern GTY(()) tree gfor_fndecl_adjustr;