Commit ec6f4336 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix stripln. Export string constants +crlf+ +lf+ +cr+. Add tests.

parent 2d68ccd4
......@@ -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))))
......@@ -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 ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment