[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-37-g5f08577

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=5f085775aba737c6e829b3e06abb66a64c83b057

The branch, stable-2.0 has been updated
       via  5f085775aba737c6e829b3e06abb66a64c83b057 (commit)
      from  8b22ced1c9dee2743eedb5658172e931a42e8453 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 5f085775aba737c6e829b3e06abb66a64c83b057
Author: Daniel Hartwig <address@hidden>
Date:   Mon Oct 8 18:35:00 2012 +0800

    In string-split, add support for character sets and predicates.
    
    * libguile/srfi-13.c (string-split): Add support for splitting on
      character sets and predicates, like string-index and others.
    * test-suite/tests/strings.test (string-split): Add tests covering
      the new argument types.
    * doc/ref/api-data.texi (string-split): Update.
    
    Signed-off-by: Mark H Weaver <address@hidden>

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-data.texi         |   22 +++++++--
 libguile/srfi-13.c            |   97 ++++++++++++++++++++++++++++-------------
 libguile/srfi-13.h            |    2 +-
 test-suite/tests/strings.test |   62 ++++++++++++++++++++++++++-
 4 files changed, 146 insertions(+), 37 deletions(-)

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 39c9790..6d8de2b 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3152,12 +3152,24 @@ These procedures are useful for similar tasks.
 Convert the string @var{str} into a list of characters.
 @end deffn
 
address@hidden {Scheme Procedure} string-split str chr
address@hidden {C Function} scm_string_split (str, chr)
address@hidden {Scheme Procedure} string-split str char_pred
address@hidden {C Function} scm_string_split (str, char_pred)
 Split the string @var{str} into a list of substrings delimited
-by appearances of the character @var{chr}.  Note that an empty substring
-between separator characters will result in an empty string in the
-result list.
+by appearances of characters that
+
address@hidden @bullet
address@hidden
+equal @var{char_pred}, if it is a character,
+
address@hidden
+satisfy the predicate @var{char_pred}, if it is a procedure,
+
address@hidden
+are in the set @var{char_pred}, if it is a character set.
address@hidden itemize
+
+Note that an empty substring between separator characters will result in
+an empty string in the result list.
 
 @lisp
 (string-split "root:x:0:0:root:/root:/bin/bash" #\:)
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 2834553..97c5a1d 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -2993,11 +2993,22 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 
3, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
-           (SCM str, SCM chr),
+           (SCM str, SCM char_pred),
            "Split the string @var{str} into a list of the substrings 
delimited\n"
-           "by appearances of the character @var{chr}.  Note that an empty 
substring\n"
-           "between separator characters will result in an empty string in 
the\n"
-           "result list.\n"
+            "by appearances of characters that\n"
+            "\n"
+            "@itemize @bullet\n"
+            "@item\n"
+            "equal @var{char_pred}, if it is a character,\n"
+            "\n"
+            "@item\n"
+            "satisfy the predicate @var{char_pred}, if it is a procedure,\n"
+            "\n"
+            "@item\n"
+            "are in the set @var{char_pred}, if it is a character set.\n"
+            "@end itemize\n\n"
+            "Note that an empty substring between separator characters\n"
+            "will result in an empty string in the result list.\n"
            "\n"
            "@lisp\n"
            "(string-split \"root:x:0:0:root:/root:/bin/bash\" #\\:)\n"
@@ -3014,47 +3025,73 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_string_split
 {
-  long idx, last_idx;
-  int narrow;
   SCM res = SCM_EOL;
 
   SCM_VALIDATE_STRING (1, str);
-  SCM_VALIDATE_CHAR (2, chr);
   
-  /* This is explicit wide/narrow logic (instead of using
-     scm_i_string_ref) is a speed optimization.  */
-  idx = scm_i_string_length (str);
-  narrow = scm_i_is_narrow_string (str);
-  if (narrow)
+  if (SCM_CHARP (char_pred))
     {
-      const char *buf = scm_i_string_chars (str);
-      while (idx >= 0)
+      long idx, last_idx;
+      int narrow;
+
+      /* This is explicit wide/narrow logic (instead of using
+         scm_i_string_ref) is a speed optimization.  */
+      idx = scm_i_string_length (str);
+      narrow = scm_i_is_narrow_string (str);
+      if (narrow)
+        {
+          const char *buf = scm_i_string_chars (str);
+          while (idx >= 0)
+            {
+              last_idx = idx;
+              while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(char_pred))
+                idx--;
+              if (idx >= 0)
+                {
+                  res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+                  idx--;
+                }
+            }
+        }
+      else
         {
-          last_idx = idx;
-          while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(chr))
-            idx--;
-          if (idx >= 0)
+          const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+          while (idx >= 0)
             {
-              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
-              idx--;
+              last_idx = idx;
+              while (idx > 0 && buf[idx-1] != SCM_CHAR(char_pred))
+                idx--;
+              if (idx >= 0)
+                {
+                  res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+                  idx--;
+                }
             }
         }
     }
   else
     {
-      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
-      while (idx >= 0)
+      SCM sidx, slast_idx;
+
+      if (!SCM_CHARSETP (char_pred))
+        SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
+                    char_pred, SCM_ARG2, FUNC_NAME);
+
+      /* Supporting predicates and character sets involves handling SCM
+         values so there is less chance to optimize. */
+      slast_idx = scm_string_length (str);
+      for (;;)
         {
-          last_idx = idx;
-          while (idx > 0 && buf[idx-1] != SCM_CHAR(chr))
-            idx--;
-          if (idx >= 0)
-            {
-              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
-              idx--;
-            }
+          sidx = scm_string_index_right (str, char_pred, SCM_INUM0, slast_idx);
+          if (scm_is_false (sidx))
+            break;
+          res = scm_cons (scm_substring (str, scm_oneplus (sidx), slast_idx), 
res);
+          slast_idx = sidx;
         }
+
+      res = scm_cons (scm_substring (str, SCM_INUM0, slast_idx), res);
     }
+
   scm_remember_upto_here_1 (str);
   return res;
 }
diff --git a/libguile/srfi-13.h b/libguile/srfi-13.h
index f63239a..325e222 100644
--- a/libguile/srfi-13.h
+++ b/libguile/srfi-13.h
@@ -110,7 +110,7 @@ SCM_API SCM scm_xsubstring (SCM s, SCM from, SCM to, SCM 
start, SCM end);
 SCM_API SCM scm_string_xcopy_x (SCM target, SCM tstart, SCM s, SCM sfrom, SCM 
sto, SCM start, SCM end);
 SCM_API SCM scm_string_replace (SCM s1, SCM s2, SCM start1, SCM end1, SCM 
start2, SCM end2);
 SCM_API SCM scm_string_tokenize (SCM s, SCM token_char, SCM start, SCM end);
-SCM_API SCM scm_string_split (SCM s, SCM chr);
+SCM_API SCM scm_string_split (SCM s, SCM char_pred);
 SCM_API SCM scm_string_filter (SCM char_pred, SCM s, SCM start, SCM end);
 SCM_API SCM scm_string_delete (SCM char_pred, SCM s, SCM start, SCM end);
 
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index d892b70..679e173 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -557,7 +557,67 @@
   (pass-if "char 255"
     (equal? '("a" "b")
            (string-split (string #\a (integer->char 255) #\b)
-                         (integer->char 255)))))
+                         (integer->char 255))))
+
+  (pass-if "empty string - char"
+    (equal? '("")
+            (string-split "" #\:)))
+
+  (pass-if "non-empty - char - no delimiters"
+    (equal? '("foobarfrob")
+            (string-split "foobarfrob" #\:)))
+
+  (pass-if "non-empty - char - delimiters"
+    (equal? '("foo" "bar" "frob")
+            (string-split "foo:bar:frob" #\:)))
+
+  (pass-if "non-empty - char - leading delimiters"
+    (equal? '("" "" "foo" "bar" "frob")
+            (string-split "::foo:bar:frob" #\:)))
+
+  (pass-if "non-empty - char - trailing delimiters"
+    (equal? '("foo" "bar" "frob" "" "")
+            (string-split "foo:bar:frob::" #\:)))
+
+  (pass-if "empty string - charset"
+    (equal? '("")
+            (string-split "" (char-set #\:))))
+
+  (pass-if "non-empty - charset - no delimiters"
+    (equal? '("foobarfrob")
+            (string-split "foobarfrob" (char-set #\:))))
+
+  (pass-if "non-empty - charset - delimiters"
+    (equal? '("foo" "bar" "frob")
+            (string-split "foo:bar:frob" (char-set #\:))))
+
+  (pass-if "non-empty - charset - leading delimiters"
+    (equal? '("" "" "foo" "bar" "frob")
+            (string-split "::foo:bar:frob" (char-set #\:))))
+
+  (pass-if "non-empty - charset - trailing delimiters"
+    (equal? '("foo" "bar" "frob" "" "")
+            (string-split "foo:bar:frob::" (char-set #\:))))
+
+  (pass-if "empty string - pred"
+    (equal? '("")
+            (string-split "" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - no delimiters"
+    (equal? '("foobarfrob")
+            (string-split "foobarfrob" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - delimiters"
+    (equal? '("foo" "bar" "frob")
+            (string-split "foo:bar:frob" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - leading delimiters"
+    (equal? '("" "" "foo" "bar" "frob")
+            (string-split "::foo:bar:frob" (negate char-alphabetic?))))
+
+  (pass-if "non-empty - pred - trailing delimiters"
+    (equal? '("foo" "bar" "frob" "" "")
+            (string-split "foo:bar:frob::" (negate char-alphabetic?)))))
 
 (with-test-prefix "substring-move!"
 


hooks/post-receive
-- 
GNU Guile