diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 23f3ce1f76595cf95e8c94c3dcda75400542e0a3..bbc57f7dd65dfeb71dfd77678163ace4a0935508 100644
--- a/gcc/testsuite/ChangeLog
+++ b/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.
diff --git a/gcc/testsuite/gfortran.dg/trim_1.f90 b/gcc/testsuite/gfortran.dg/trim_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ac1e1f2032dd9eceb067e27480e58201e3dc4c70
--- /dev/null
+++ b/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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 500280604f066e12c06328e379eb5895a440edc8..45779d673fdefcb9c79fcfb65c48a182aa7d4629 100644
--- a/libgfortran/ChangeLog
+++ b/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
diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index f6d9663f0baa3d489b7a69b63f442b4c284e5906..491b45e21df2217794cb039e7f05ffc87e694ef4 100644
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/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
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index 0008db5b2fc121987a692d66640d0ac2bd4abc8d..5497991c76b56edf8e0cd65534d856e7495bda28 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/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;
}