From 7fed10780b69c3892b33d665b547afa70943adf2 Mon Sep 17 00:00:00 2001 From: Ken Harris Date: Thu, 13 Jun 2013 01:08:37 -0700 Subject: [PATCH] STRING-TRIM and friends. --- src/string.lisp | 21 ++++++++----------- tests/strings.lisp | 57 ++++++++++++++++++++++++++-------------------------- 2 files changed, 36 insertions(+), 42 deletions(-) diff --git a/src/string.lisp b/src/string.lisp index 8588699..3059b4e 100644 --- a/src/string.lisp +++ b/src/string.lisp @@ -186,14 +186,8 @@ (unless (char-equal (char s1 (+ start1 i)) (char s2 (+ start2 i))) (return-from string-not-equal (+ start1 i)))))) -;; TODO: these STRING-* functions need :FROM-END T! can i do it some other way? (e.g., DOTIMES to index backwards from the end) - -;; (defun string-trim (character-bag string) -;; (let* ((string (string string)) -;; (n (length string)) -;; (start (or (position-if-not (lambda (c) (find c character-bag)) string) n)) -;; (end (or (position-if-not (lambda (c) (find c character-bag)) string :from-end t) 0))) -;; (subseq string start (1+ end)))) +(defun string-trim (character-bag string) + (string-left-trim character-bag (string-right-trim character-bag string))) (defun string-left-trim (character-bag string) (let* ((string (string string)) @@ -201,8 +195,9 @@ (start (or (position-if-not (lambda (c) (find c character-bag)) string) n))) (subseq string start))) -;; (defun string-right-trim (character-bag string) -;; (let* ((string (string string)) -;; (n (length string)) -;; (end (or (position-if-not (lambda (c) (find c character-bag)) string :from-end t) 0))) -;; (subseq string 0 (1+ end)))) +(defun string-right-trim (character-bag string) + (let* ((string (string string)) + (n (length string))) + (dotimes (i n "") + (when (not (find (char string (- n i 1)) character-bag)) + (return-from string-right-trim (subseq string 0 (- n i))))))) diff --git a/tests/strings.lisp b/tests/strings.lisp index 81b5552..3507f54 100644 --- a/tests/strings.lisp +++ b/tests/strings.lisp @@ -191,28 +191,27 @@ -;; JSCL: my implementation of these needs :FROM-END, which doesn't exist yet. -;; (test (string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak")) +(test (string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak")) ;; (test (string= (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans ;; ") "garbanzo beans")) -;; (test (string= (string-trim " (*)" " ( *three (silly) words* ) ") -;; "three (silly) words")) -;; (test (string= (string-left-trim "abc" "labcabcabc") "labcabcabc")) -;; (test (string= (string-left-trim " (*)" " ( *three (silly) words* ) ") -;; "three (silly) words* ) ")) -;; (test (string= (string-right-trim " (*)" " ( *three (silly) words* ) ") -;; " ( *three (silly) words")) -;; (test (string= (string-trim "ABC" "abc") "abc")) -;; (test (string= (string-trim "AABBCC" "abc") "abc")) -;; (test (string= (string-trim "" "abc") "abc")) -;; (test (string= (string-trim "ABC" "") "")) -;; (test (string= (string-trim "cba" "abc") "")) -;; (test (string= (string-trim "cba" "abccba") "")) -;; (test (string= (string-trim "ccbbba" "abccba") "")) -;; (test (string= (string-trim "cba" "abcxabc") "x")) -;; (test (string= (string-trim "xyz" "xxyabcxyyz") "abc")) -;; (test (string= (string-trim "CBA" 'abcxabc) "X")) -;; (test (string= (string-trim "a" #\a) "")) +(test (string= (string-trim " (*)" " ( *three (silly) words* ) ") + "three (silly) words")) +(test (string= (string-left-trim "abc" "labcabcabc") "labcabcabc")) +(test (string= (string-left-trim " (*)" " ( *three (silly) words* ) ") + "three (silly) words* ) ")) +(test (string= (string-right-trim " (*)" " ( *three (silly) words* ) ") + " ( *three (silly) words")) +(test (string= (string-trim "ABC" "abc") "abc")) +(test (string= (string-trim "AABBCC" "abc") "abc")) +(test (string= (string-trim "" "abc") "abc")) +(test (string= (string-trim "ABC" "") "")) +(test (string= (string-trim "cba" "abc") "")) +(test (string= (string-trim "cba" "abccba") "")) +(test (string= (string-trim "ccbbba" "abccba") "")) +(test (string= (string-trim "cba" "abcxabc") "x")) +(test (string= (string-trim "xyz" "xxyabcxyyz") "abc")) +(test (string= (string-trim "CBA" 'abcxabc) "X")) +(test (string= (string-trim "a" #\a) "")) (test (string= (string-left-trim "ABC" "abc") "abc")) @@ -225,15 +224,15 @@ (test (string= (string-left-trim "CBA" 'abcxabc) "XABC")) (test (string= (string-left-trim "a" #\a) "")) -;; (test (string= (string-right-trim "ABC" "abc") "abc")) -;; (test (string= (string-right-trim "" "abc") "abc")) -;; (test (string= (string-right-trim "ABC" "") "")) -;; (test (string= (string-right-trim "cba" "abc") "")) -;; (test (string= (string-right-trim "cba" "abccba") "")) -;; (test (string= (string-right-trim "cba" "abcxabc") "abcx")) -;; (test (string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc")) -;; (test (string= (string-right-trim "CBA" 'abcxabc) "ABCX")) -;; (test (string= (string-right-trim "a" #\a) "")) +(test (string= (string-right-trim "ABC" "abc") "abc")) +(test (string= (string-right-trim "" "abc") "abc")) +(test (string= (string-right-trim "ABC" "") "")) +(test (string= (string-right-trim "cba" "abc") "")) +(test (string= (string-right-trim "cba" "abccba") "")) +(test (string= (string-right-trim "cba" "abcxabc") "abcx")) +(test (string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc")) +(test (string= (string-right-trim "CBA" 'abcxabc) "ABCX")) +(test (string= (string-right-trim "a" #\a) "")) -- 1.7.10.4