* check.c (gfc_check_repeat): Check arguments are scalar.

	(gfc_check_trim): New function.
	* intrinsic.h (gfc_check_trim): Add prototype.
	* intrinsic.c (add_functions): Use it.
	* trans.h (gfor_fndecl_string_trim, gfor_fndecl_string_repeat):
	Decalare.
	* trans-decl.c: Ditto.
	(gfc_build_intrinsic_fucntion_decls): Set them.
	* trans-intrinsic.c (gfc_conv_intrinsic_len): Handle result vars.
	(gfc_conv_intrinsic_trim): New function.
	(gfc_conv_intrinsic_repeat): New function.
	(gfc_conv_intrinsic_function): Use them.
libgfortran
	* intrinsics/string_intrinsics.c (string_trim): New function.
	(string_repeat): New function.
testsuite
	* gfortran.fortran-torture/execute/intrinsic_len.f90: New test.
	* gfortran.fortran-torture/execute/intrinsic_trim.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/tree-ssa-20020619-branch@72384 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 60 insertions, 0 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c3acc5de73d..00b26720210 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2003-10-11  Huang Chun  <jiwang@mail.edu.cn>
+
+	* intrinsics/string_intrinsics.c (string_trim): New function.
+	(string_repeat): New function.
+
 2003-10-11  Paul Brook  <paul@nowt.org>
 
 	* intrinsics/dprod_r8.f90: New file.
diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index faf21c8d072..e2208ebcaae 100644
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/libgfortran/intrinsics/string_intrinsics.c
@@ -64,6 +64,11 @@ GFC_INTEGER_4 string_scan (GFC_INTEGER_4, const char *, GFC_INTEGER_4,
 GFC_INTEGER_4 string_verify (GFC_INTEGER_4, const char *, GFC_INTEGER_4,
                              const char *, GFC_LOGICAL_4);
 
+#define string_trim prefix(string_trim)
+void string_trim (GFC_INTEGER_4 *, void **, GFC_INTEGER_4, const char *);
+
+#define string_repeat prefix(string_repeat)
+void string_repeat (char *, GFC_INTEGER_4, const char *, GFC_INTEGER_4);
 
 /* The two areas may overlap so we use memmove.  */
 
@@ -160,6 +165,32 @@ concat_string (GFC_INTEGER_4 destlen, char * dest,
 }
 
 
+/* Return string with all trailing blanks removed.  */
+
+void
+string_trim (GFC_INTEGER_4 * len, void ** dest, GFC_INTEGER_4 slen, const char * src)
+{
+  int i;
+
+  /* Determine length of result string.  */
+  for (i = slen - 1; i >= 0; i--)
+    {
+      if (src[i] != ' ')
+        break;
+    }
+  *len = i + 1;
+
+  if (*len > 0)
+    {
+      /* Allocate space for result string.  */
+      internal_malloc (dest, *len);
+
+      /* copy string if necessary.  */
+      memmove (*dest, src, *len);
+    }
+}
+
+
 /* The length of a string not including trailing blanks.  */
 
 GFC_INTEGER_4
@@ -337,3 +368,27 @@ string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
 
   return 0;
 }
+
+
+/* Concatenate several copies of a string.  */
+
+void
+string_repeat (char * dest, GFC_INTEGER_4 slen, 
+               const char * src, GFC_INTEGER_4 ncopies)
+{
+  int i;
+
+  /* See if ncopies is valid.  */
+  if (ncopies < 0)
+    {
+      /* The error is already reported.  */
+      runtime_error ("Augument NCOPIES is negative.");
+    }
+
+  /* Copy characters.  */
+  for (i = 0; i < ncopies; i++) 
+    {
+      memmove (dest + (i * slen), src, slen);
+    }
+}
+