diff --git a/test/test-utilities.script b/test/test-utilities.script index 5b67b547cc3d9d3003395e78699cad36cfd43cc8..19a21f772288bdc198d05e82629f1306b87bc131 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -228,3 +228,17 @@ (assert (base-string-p (strcat (basify "ab") (basify "cd")))) (assert (not (base-string-p (strcat (basify "ab") #\c (unbasify "d"))))) (assert (base-string-p (strcat (basify "ab") #\c #\d)))) + +(assert-equal +crlf+ (map 'string 'code-char '(13 10))) +(assert-equal +lf+ (map 'string 'code-char '(10))) +(assert-equal +cr+ (map 'string 'code-char '(13))) +(defparameter acrlf (strcat "a" +crlf+)) +(defparameter blf (strcat "b" +lf+)) +(defparameter ccr (strcat "c" +cr+)) +(assert-equal `("a" ,+crlf+) (multiple-value-list (stripln acrlf))) +(assert-equal `("b" ,+lf+) (multiple-value-list (stripln blf))) +(assert-equal `("c" ,+cr+) (multiple-value-list (stripln ccr))) +(assert-equal `(,acrlf ,+crlf+) (multiple-value-list (stripln (strcat acrlf +crlf+)))) +(assert-equal `(,blf ,+cr+) (multiple-value-list (stripln (strcat blf +cr+)))) +(assert-equal `("c" ,+crlf+) (multiple-value-list (stripln (strcat ccr +lf+)))) +(assert-equal `(,(strcat acrlf "b") ,+lf+) (multiple-value-list (stripln (strcat acrlf blf)))) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index eecd7a6b3854d4b471834b83e5013e086d5691f5..a7b515a24bc9996a599bf44c5d631597e940c2ee 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -20,7 +20,7 @@ #:emptyp ;; sequences #:+non-base-chars-exist-p+ ;; characters #:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings - #:first-char #:last-char #:split-string #:stripln + #:first-char #:last-char #:split-string #:stripln #:+cr+ #:+lf+ #:+crlf+ #:string-prefix-p #:string-enclosed-p #:string-suffix-p #:find-class* ;; CLOS #:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps @@ -254,24 +254,6 @@ starting the separation from the end, e.g. when called with arguments (incf words) (setf end start)))))) - (defvar $cr (coerce #(#\Return) 'string)) - (defvar $lf (coerce #(#\Linefeed) 'string)) - (defvar $crlf (coerce #(#\Return #\Linefeed) 'string)) - - (defun stripln (x) - "Strip a string X from any ending CR, LF or CRLF. -Return two values, the stripped string and the strip that was stripped" - (check-type x string) - (let* ((len (length x)) - (endlfp (equal (last-char x) #\linefeed)) - (endcrlfp (and endlfp (<= 2 len) (eql (char x (- len 2)) #\return))) - (endcrp (equal (last-char x) #\return))) - (cond - (endlfp (values (subseq x 0 (- len 1)) $lf)) - (endcrp (values (subseq x 0 (- len 1)) $cr)) - (endcrlfp (values (subseq x 0 (- len 2)) $crlf)) - (t (values x nil))))) - (defun string-prefix-p (prefix string) "Does STRING begin with PREFIX?" (let* ((x (string prefix)) @@ -293,6 +275,22 @@ Return two values, the stripped string and the strip that was stripped" (and (string-prefix-p prefix string) (string-suffix-p string suffix)))) + (defvar +cr+ (coerce #(#\Return) 'string)) + (defvar +lf+ (coerce #(#\Linefeed) 'string)) + (defvar +crlf+ (coerce #(#\Return #\Linefeed) 'string)) + + (defun stripln (x) + "Strip a string X from any ending CR, LF or CRLF. +Return two values, the stripped string and the ending that was stripped, +or the original value and NIL if no stripping took place. +Since our STRCAT accepts NIL as empty string designator, +the two results passed to STRCAT always reconstitute the original string" + (check-type x string) + (block nil + (flet ((c (end) (when (string-suffix-p x end) + (return (values (subseq x 0 (- (length x) (length end))) end))))) + (when x (c +crlf+) (c +lf+) (c +cr+) (values x nil))))) + ;;; CLOS (with-upgradability ()