string_intrinsics.c: #include <assert.h>

2009-03-28  Daniel Kraft  <d@domob.eu>

	* intrinsics/string_intrinsics.c: #include <assert.h>
	* intrinsics/string_intrinsics_inc.c (string_trim): Use string_len_trim
	instead of calculating the length directly.
	(string_len_trim): For KIND=1, speed search up.

2009-03-28  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/trim_1.f90: New test.

From-SVN: r145192

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2009-03-28  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.dg/trim_1.f90: New test.
+
 2009-03-28  Richard Guenther  <rguenther@suse.de>
 
 	* gcc.dg/Warray-bounds.c: Do not use redundant stores.

gcc/testsuite/gfortran.dg/trim_1.f90

@@ -0,0 +1,41 @@
+! { dg-do run }
+
+! Torture-test TRIM and LEN_TRIM for correctness.
+
+
+! Given a total string length and a trimmed length, construct an
+! appropriate string and check gfortran gets it right.
+
+SUBROUTINE check_trim (full_len, trimmed_len)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: full_len, trimmed_len
+  CHARACTER(LEN=full_len) :: string
+
+  string = ""
+  IF (trimmed_len > 0) THEN
+    string(trimmed_len:trimmed_len) = "x"
+  END IF
+
+  IF (LEN (string) /= full_len &
+      .OR. LEN_TRIM (string) /= trimmed_len &
+      .OR. LEN (TRIM (string)) /= trimmed_len &
+      .OR. TRIM (string) /= string (1:trimmed_len)) THEN
+    PRINT *, full_len, trimmed_len
+    PRINT *, LEN (string), LEN_TRIM (string)
+    CALL abort ()
+  END IF
+END SUBROUTINE check_trim
+
+
+! The main program, check with various combinations.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: i, j
+
+  DO i = 0, 20
+    DO j = 0, i
+      CALL check_trim (i, j)
+    END DO
+  END DO
+END PROGRAM main

libgfortran/ChangeLog

@@ -1,3 +1,10 @@
+2009-03-28  Daniel Kraft  <d@domob.eu>
+
+	* intrinsics/string_intrinsics.c: #include <assert.h>
+	* intrinsics/string_intrinsics_inc.c (string_trim): Use string_len_trim
+	instead of calculating the length directly.
+	(string_len_trim): For KIND=1, speed search up.
+
 2009-03-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/39528

libgfortran/intrinsics/string_intrinsics.c

@@ -39,6 +39,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <stdlib.h>
 #include <string.h>
+#include <assert.h>
 
 
 /* Helper function to set parts of wide strings to a constant (usually

libgfortran/intrinsics/string_intrinsics_inc.c

@@ -165,15 +165,7 @@ void
 string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen,
 	     const CHARTYPE *src)
 {
-  gfc_charlen_type i;
-
-  /* Determine length of result string.  */
-  for (i = slen - 1; i >= 0; i--)
-    {
-      if (src[i] != ' ')
-        break;
-    }
-  *len = i + 1;
+  *len = string_len_trim (slen, src);
 
   if (*len == 0)
     *dest = &zero_length_string;
@@ -193,13 +185,57 @@ string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen,
 gfc_charlen_type
 string_len_trim (gfc_charlen_type len, const CHARTYPE *s)
 {
+  const gfc_charlen_type long_len = (gfc_charlen_type) sizeof (unsigned long);
   gfc_charlen_type i;
 
-  for (i = len - 1; i >= 0; i--)
+  i = len - 1;
+
+  /* If we've got the standard (KIND=1) character type, we scan the string in
+     long word chunks to speed it up (until a long word is hit that does not
+     consist of ' 's).  */
+  if (sizeof (CHARTYPE) == 1 && i >= long_len)
     {
-      if (s[i] != ' ')
-        break;
+      int starting;
+      unsigned long blank_longword;
+
+      /* Handle the first characters until we're aligned on a long word
+	 boundary.  Actually, s + i + 1 must be properly aligned, because
+	 s + i will be the last byte of a long word read.  */
+      starting = ((unsigned long) (s + i + 1)) % long_len;
+      i -= starting;
+      for (; starting > 0; --starting)
+	if (s[i + starting] != ' ')
+	  return i + starting + 1;
+
+      /* Handle the others in a batch until first non-blank long word is
+	 found.  Here again, s + i is the last byte of the current chunk,
+	 to it starts at s + i - sizeof (long) + 1.  */
+
+#if __SIZEOF_LONG__ == 4
+      blank_longword = 0x20202020L;
+#elif __SIZEOF_LONG__ == 8
+      blank_longword = 0x2020202020202020L;
+#else
+      #error Invalid size of long!
+#endif
+
+      while (i >= long_len)
+	{
+	  i -= long_len;
+	  if (*((unsigned long*) (s + i + 1)) != blank_longword)
+	    {
+	      i += long_len;
+	      break;
+	    }
+	}
+
+      /* Now continue for the last characters with naive approach below.  */
+      assert (i >= 0);
     }
+
+  /* Simply look for the first non-blank character.  */
+  while (i >= 0 && s[i] == ' ')
+    --i;
   return i + 1;
 }