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.


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

3 files changed, 72 insertions, 1 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bb999ece2f0..e205466bb46 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29828
+	* intrinsics/string_intrinsics.c (string_minmax): New function
+	and prototype.
+	* gfortran.map (GFORTRAN_1.0): Add _gfortran_string_minmax
+
 2007-08-05  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/31202
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index c16dd1eee33..ed881ebfbcc 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -941,6 +941,7 @@ GFORTRAN_1.0 {
     _gfortran_st_rewind;
     _gfortran_string_index;
     _gfortran_string_len_trim;
+    _gfortran_string_minmax;
     _gfortran_string_scan;
     _gfortran_string_trim;
     _gfortran_string_verify;
diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index 7c22c16abfe..3e0940f59ee 100644
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/libgfortran/intrinsics/string_intrinsics.c
@@ -1,5 +1,5 @@
 /* String intrinsics helper functions.
-   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Copyright 2002, 2005, 2007 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -38,6 +38,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <stdlib.h>
 #include <string.h>
+#include <stdarg.h>
 
 #include "libgfortran.h"
 
@@ -73,6 +74,9 @@ export_proto(string_verify);
 extern void string_trim (GFC_INTEGER_4 *, void **, GFC_INTEGER_4, const char *);
 export_proto(string_trim);
 
+extern void string_minmax (GFC_INTEGER_4 *, void **, int, int, ...);
+export_proto(string_minmax);
+
 /* Strings of unequal length are extended with pad characters.  */
 
 GFC_INTEGER_4
@@ -351,3 +355,62 @@ string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
 
   return 0;
 }
+
+
+/* MIN and MAX intrinsics for strings.  The front-end makes sure that
+   nargs is at least 2.  */
+
+void
+string_minmax (GFC_INTEGER_4 *rlen, void **dest, int op, int nargs, ...)
+{
+  va_list ap;
+  int i;
+  char * next, * res;
+  GFC_INTEGER_4 nextlen, reslen;
+
+  va_start (ap, nargs);
+  reslen = va_arg (ap, GFC_INTEGER_4);
+  res = va_arg (ap, char *);
+  *rlen = reslen;
+
+  if (res == NULL)
+    runtime_error ("First argument of '%s' intrinsic should be present",
+		   op > 0 ? "MAX" : "MIN");
+
+  for (i = 1; i < nargs; i++)
+    {
+      nextlen = va_arg (ap, GFC_INTEGER_4);
+      next = va_arg (ap, char *);
+
+
+      if (next == NULL)
+	{
+	  if (i == 1)
+	    runtime_error ("Second argument of '%s' intrinsic should be "
+			   "present", op > 0 ? "MAX" : "MIN");
+	  else
+	    continue;
+	}
+
+      if (nextlen > *rlen)
+	*rlen = nextlen;
+
+      if (op * compare_string (reslen, res, nextlen, next) < 0)
+	{
+	  reslen = nextlen;
+	  res = next;
+	}
+    }
+  va_end (ap);
+
+  if (*rlen > 0)
+    {
+      char * tmp = internal_malloc_size (*rlen);
+      memcpy (tmp, res, reslen);
+      memset (&tmp[reslen], ' ', *rlen - reslen);
+      *dest = tmp;
+    }
+  else
+    *dest = NULL;
+}
+