summaryrefslogtreecommitdiffstats
path: root/libgfortran/intrinsics/string_intrinsics.c
diff options
context:
space:
mode:
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>2007-08-06 20:47:17 +0000
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>2007-08-06 20:47:17 +0000
commit5fcc6ec223fed0d7dcd200bd3ee08ef6ae1c4965 (patch)
tree2abbc1521f7910f2a1dce1f5f9199ff847083230 /libgfortran/intrinsics/string_intrinsics.c
parent0f2457b8d9212d7a56979ee0217b69466b2d31cc (diff)
downloadppe42-gcc-5fcc6ec223fed0d7dcd200bd3ee08ef6ae1c4965.tar.gz
ppe42-gcc-5fcc6ec223fed0d7dcd200bd3ee08ef6ae1c4965.zip
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
Diffstat (limited to 'libgfortran/intrinsics/string_intrinsics.c')
-rw-r--r--libgfortran/intrinsics/string_intrinsics.c65
1 files changed, 64 insertions, 1 deletions
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;
+}
+
OpenPOWER on IntegriCloud