From 2305b15fffc6679e9fdf42f6cd5bf49ee0dd3ce8 Mon Sep 17 00:00:00 2001 From: Ken Harris Date: Thu, 13 Jun 2013 01:35:37 -0700 Subject: [PATCH 1/1] NSTRING-UPCASE, NSTRING-DOWNCASE, NSTRING-CAPITALIZE. --- src/string.lisp | 33 +++++++++++--- tests/strings.lisp | 121 +++++++++++++++++++++++++++------------------------- 2 files changed, 89 insertions(+), 65 deletions(-) diff --git a/src/string.lisp b/src/string.lisp index 3059b4e..c9267f0 100644 --- a/src/string.lisp +++ b/src/string.lisp @@ -117,7 +117,7 @@ (!reduce #'concat-two strs ""))) -(defun string-upcase (string &key start end) +(defun string-upcase (string &key (start 0) end) (let* ((string (string string)) (new (make-string (length string)))) (dotimes (i (length string) new) @@ -127,7 +127,13 @@ (char-upcase (char string i)) (char string i)))))) -(defun string-downcase (string &key start end) +(defun nstring-upcase (string &key (start 0) end) + (let ((end (or end (length string)))) + (dotimes (i (- end start) string) + (aset string (+ start i) + (char-upcase (char string (+ start i))))))) + +(defun string-downcase (string &key (start 0) end) (let* ((string (string string)) (new (make-string (length string)))) (dotimes (i (length string) new) @@ -137,7 +143,13 @@ (char-downcase (char string i)) (char string i)))))) -(defun string-capitalize (string &key start end) +(defun nstring-downcase (string &key (start 0) end) + (let ((end (or end (length string)))) + (dotimes (i (- end start) string) + (aset string (+ start i) + (char-downcase (char string (+ start i))))))) + +(defun string-capitalize (string &key (start 0) end) (let* ((string (string string)) (new (make-string (length string))) (just-saw-alphanum-p nil)) @@ -146,16 +158,23 @@ (cond ((or (and start (< i start)) (and end (> i end))) (char string i)) - ((or (= i (or start 0)) + ((or (= i start) (not just-saw-alphanum-p)) (char-upcase (char string i))) (t (char-downcase (char string i))))) (setq just-saw-alphanum-p (alphanumericp (char string i)))))) -;; TODO: NSTRING-{UPCASE,DOWNCASE,CAPITALIZE} -;; - Q: can i just extract the above functions without the MAKE-STRING call, and then have the STRING-* variants do MAKE-STRING + NSTRING-*? -;; - NOTE: sacla's tests depend on COPY-SEQ, which doesn't exist yet. +(defun nstring-capitalize (string &key (start 0) end) + (let ((end (or end (length string))) + (just-saw-alphanum-p nil)) + (dotimes (i (- end start) string) + (aset string (+ start i) + (if (or (zerop i) + (not just-saw-alphanum-p)) + (char-upcase (char string (+ start i))) + (char-downcase (char string (+ start i))))) + (setq just-saw-alphanum-p (alphanumericp (char string (+ start i))))))) (defun string-equal (s1 s2 &key start1 end1 start2 end2) (let* ((s1 (string s1)) diff --git a/tests/strings.lisp b/tests/strings.lisp index 3507f54..43f1337 100644 --- a/tests/strings.lisp +++ b/tests/strings.lisp @@ -130,64 +130,69 @@ (test (string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c")) (test (string= (string-capitalize "a fool" :start 2 :end nil) "a Fool")) -;; JSCL: no COPY-SEQ yet -;; (test (let ((str (copy-seq "0123ABCD890a"))) -;; (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a") -;; (string= str "0123AbcD890a")))) - -;; (test (let* ((str0 (copy-seq "abcde")) -;; (str (nstring-upcase str0))) -;; (and (eq str0 str) -;; (string= str "ABCDE")))) -;; (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?")) -;; (str (nstring-upcase str0))) -;; (and (eq str0 str) -;; (string= str "DR. LIVINGSTON, I PRESUME?")))) -;; (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?")) -;; (str (nstring-upcase str0 :start 6 :end 10))) -;; (and (eq str0 str) -;; (string= str "Dr. LiVINGston, I presume?")))) - -;; (test (let* ((str0 (copy-seq "abcde")) -;; (str (nstring-upcase str0 :start 2 :end nil))) -;; (string= str "abCDE"))) - - - -;; (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?")) -;; (str (nstring-downcase str0))) -;; (and (eq str0 str) -;; (string= str "dr. livingston, i presume?")))) -;; (test (let* ((str0 (copy-seq "ABCDE")) -;; (str (nstring-downcase str0 :start 2 :end nil))) -;; (string= str "ABcde"))) - -;; (test (let* ((str0 (copy-seq "elm 13c arthur;fig don't")) -;; (str (nstring-capitalize str0))) -;; (and (eq str0 str) -;; (string= str "Elm 13c Arthur;Fig Don'T")))) - -;; (test (let* ((str0 (copy-seq " hello ")) -;; (str (nstring-capitalize str0))) -;; (and (eq str0 str) -;; (string= str " Hello ")))) -;; (test (let* ((str0 (copy-seq -;; "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")) -;; (str (nstring-capitalize str0))) -;; (and (eq str0 str) -;; (string= str -;; "Occluded Casements Forestall Inadvertent Defenestration")))) -;; (test (let* ((str0 (copy-seq "DON'T!")) -;; (str (nstring-capitalize str0))) -;; (and (eq str0 str) -;; (string= str "Don'T!")))) ;not "Don't!" -;; (test (let* ((str0 (copy-seq "pipe 13a, foo16c")) -;; (str (nstring-capitalize str0))) -;; (and (eq str0 str) -;; (string= str "Pipe 13a, Foo16c")))) -;; (test (let* ((str0 (copy-seq "a fool")) -;; (str (nstring-capitalize str0 :start 2 :end nil))) -;; (string= str "a Fool"))) +;; JSCL HACK: a simple COPY-SEQ for testing string functions, since we don't have a real one yet +(defun copy-seq (string) + (let ((copy (make-string (length string)))) + (dotimes (i (length string) copy) + (aset copy i (char string i))))) + +(test (let ((str (copy-seq "0123ABCD890a"))) + (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a") + (string= str "0123AbcD890a")))) + +(test (let* ((str0 (copy-seq "abcde")) + (str (nstring-upcase str0))) + (and (eq str0 str) + (string= str "ABCDE")))) +(test (let* ((str0 (copy-seq "Dr. Livingston, I presume?")) + (str (nstring-upcase str0))) + (and (eq str0 str) + (string= str "DR. LIVINGSTON, I PRESUME?")))) +(test (let* ((str0 (copy-seq "Dr. Livingston, I presume?")) + (str (nstring-upcase str0 :start 6 :end 10))) + (and (eq str0 str) + (string= str "Dr. LiVINGston, I presume?")))) + +(test (let* ((str0 (copy-seq "abcde")) + (str (nstring-upcase str0 :start 2 :end nil))) + (string= str "abCDE"))) + + + +(test (let* ((str0 (copy-seq "Dr. Livingston, I presume?")) + (str (nstring-downcase str0))) + (and (eq str0 str) + (string= str "dr. livingston, i presume?")))) +(test (let* ((str0 (copy-seq "ABCDE")) + (str (nstring-downcase str0 :start 2 :end nil))) + (string= str "ABcde"))) + +(test (let* ((str0 (copy-seq "elm 13c arthur;fig don't")) + (str (nstring-capitalize str0))) + (and (eq str0 str) + (string= str "Elm 13c Arthur;Fig Don'T")))) + +(test (let* ((str0 (copy-seq " hello ")) + (str (nstring-capitalize str0))) + (and (eq str0 str) + (string= str " Hello ")))) +(test (let* ((str0 (copy-seq + "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")) + (str (nstring-capitalize str0))) + (and (eq str0 str) + (string= str + "Occluded Casements Forestall Inadvertent Defenestration")))) +(test (let* ((str0 (copy-seq "DON'T!")) + (str (nstring-capitalize str0))) + (and (eq str0 str) + (string= str "Don'T!")))) ;not "Don't!" +(test (let* ((str0 (copy-seq "pipe 13a, foo16c")) + (str (nstring-capitalize str0))) + (and (eq str0 str) + (string= str "Pipe 13a, Foo16c")))) +(test (let* ((str0 (copy-seq "a fool")) + (str (nstring-capitalize str0 :start 2 :end nil))) + (string= str "a Fool"))) -- 1.7.10.4