string-right-trim.lsp 6.26 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct  4 04:59:46 2002
;;;; Contains: Tests of STRING-RIGHT-TRIM

(in-package :cl-test)

(deftest string-right-trim.1
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
10
         (s2 (string-right-trim "ab" s)))
11 12 13 14 15 16
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.2
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
17
         (s2 (string-right-trim '(#\a #\b) s)))
18 19 20 21 22 23
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.3
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
24
         (s2 (string-right-trim #(#\a #\b) s)))
25 26 27 28 29 30
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.4
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
31 32
         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b))
                          s)))
33 34 35 36 37 38
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.5
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
39 40 41
         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)
                                      :element-type 'character)
                          s)))
42 43 44 45 46 47
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.6
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
48 49 50
         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)
                                      :element-type 'standard-char)
                          s)))
51 52 53 54 55 56
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.7
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
57 58 59
         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)
                                      :element-type 'base-char)
                          s)))
60 61 62 63 64 65
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.8
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
66 67 68 69
         (s2 (string-right-trim (make-array 4 :initial-contents '(#\a #\b #\c #\d)
                                      :element-type 'character
                                      :fill-pointer 2)
                          s)))
70 71 72 73 74
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.9
75
  (let* ((s (make-array 7 :initial-contents "abcdaba"
sds's avatar
sds committed
76 77 78
                        :element-type 'character
                        ))
         (s2 (string-right-trim "ab" s)))
79 80 81 82 83
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.10
84
  (let* ((s (make-array 9 :initial-contents "abcdabadd"
sds's avatar
sds committed
85 86 87
                        :element-type 'character
                        :fill-pointer 7))
         (s2 (string-right-trim "ab" s)))
88 89 90 91
    (values s s2))
  "abcdaba"
  "abcd")

92 93
(deftest string-right-trim.10a
  (let* ((s (make-array 9 :initial-contents "abcdabadd"
sds's avatar
sds committed
94 95 96
                        :element-type 'base-char
                        :fill-pointer 7))
         (s2 (string-right-trim "ab" s)))
97 98 99 100 101 102
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.10b
  (let* ((s (make-array 9 :initial-contents "abcdabadd"
sds's avatar
sds committed
103 104 105 106
                        :element-type 'base-char
                        :adjustable t
                        :fill-pointer 7))
         (s2 (string-right-trim "ab" s)))
107 108 109 110
    (values s s2))
  "abcdaba"
  "abcd")

111
(deftest string-right-trim.11
112
  (let* ((s (make-array 7 :initial-contents "abcdaba"
sds's avatar
sds committed
113 114 115
                        :element-type 'standard-char
                        ))
         (s2 (string-right-trim "ab" s)))
116 117 118 119 120
    (values s s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.12
121
  (let* ((s (make-array 7 :initial-contents "abcdaba"
sds's avatar
sds committed
122 123 124
                        :element-type 'base-char
                        ))
         (s2 (string-right-trim "ab" s)))
125 126 127
    (values s s2))
  "abcdaba"
  "abcd")
128 129 130 131

;;; Test that trimming is case sensitive
(deftest string-right-trim.13
  (let* ((s (copy-seq "Aa"))
sds's avatar
sds committed
132
         (s2 (string-right-trim "a" s)))
133 134 135 136 137
    (values s s2))
  "Aa" "A")

(deftest string-right-trim.14
  (let* ((s '|abcdaba|)
sds's avatar
sds committed
138
         (s2 (string-right-trim "ab" s)))
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
    (values (symbol-name s) s2))
  "abcdaba"
  "abcd")

(deftest string-right-trim.15
  (string-right-trim "abc" "")
  "")

(deftest string-right-trim.16
  (string-right-trim "a" #\a)
  "")

(deftest string-right-trim.17
  (string-right-trim "b" #\a)
  "a")

(deftest string-right-trim.18
  (string-right-trim "" (copy-seq "abcde"))
  "abcde")

(deftest string-right-trim.19
  (string-right-trim "abc" (copy-seq "abcabcabc"))
  "")

163
(deftest string-right-trim.20
164
  :notes (:nil-vectors-are-strings)
165 166 167 168
  (string-right-trim "abcd" (make-array '(0) :element-type nil))
  "")

(deftest string-right-trim.21
169
  :notes (:nil-vectors-are-strings)
170 171 172
  (string-right-trim (make-array '(0) :element-type nil) "abcd")
  "abcd")

173 174
(deftest string-right-trim.22
  (let ((s (make-array '(6) :initial-contents "abcaeb"
sds's avatar
sds committed
175 176
                       :element-type 'base-char
                       :adjustable t)))
177 178 179 180 181
    (values (string-right-trim "ab" s) s))
  "abcae" "abcaeb")

(deftest string-right-trim.23
  (let ((s (make-array '(6) :initial-contents "abcaeb"
sds's avatar
sds committed
182 183
                       :element-type 'character
                       :adjustable t)))
184 185 186 187 188
    (values (string-right-trim "ab" s) s))
  "abcae" "abcaeb")

(deftest string-right-trim.24
  (let* ((etype 'base-char)
sds's avatar
sds committed
189 190 191 192 193
         (s0 (make-array '(6) :initial-contents "abcaeb"
                         :element-type etype))
         (s (make-array '(3) :element-type etype
                        :displaced-to s0
                        :displaced-index-offset 1)))
194 195 196 197 198
    (values (string-right-trim "ab" s) s s0))
  "bc" "bca" "abcaeb")

(deftest string-right-trim.25
  (let* ((etype 'character)
sds's avatar
sds committed
199 200 201 202 203
         (s0 (make-array '(6) :initial-contents "abcaeb"
                         :element-type etype))
         (s (make-array '(3) :element-type etype
                        :displaced-to s0
                        :displaced-index-offset 1)))
204 205 206
    (values (string-right-trim "ab" s) s s0))
  "bc" "bca" "abcaeb")

207 208 209 210
(deftest string-right-trim.order.1
  (let ((i 0) x y)
    (values
     (string-right-trim (progn (setf x (incf i)) " ")
sds's avatar
sds committed
211 212
                       (progn (setf y (incf i))
                              (copy-seq "   abc d e f  ")))
213 214 215
     i x y))
  "   abc d e f" 2 1 2)

pfdietz's avatar
pfdietz committed
216 217
(def-fold-test string-right-trim.fold.1 (string-right-trim " " "abcd "))

218 219 220
;;; Error cases

(deftest string-right-trim.error.1
221 222
  (signals-error (string-right-trim) program-error)
  t)
223 224

(deftest string-right-trim.error.2
225 226
  (signals-error (string-right-trim "abc") program-error)
  t)
227 228

(deftest string-right-trim.error.3
229 230
  (signals-error (string-right-trim "abc" "abcdddabc" nil) program-error)
  t)