string-left-trim.lsp 6.21 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct  4 04:57:41 2002
;;;; Contains: Tests for STRING-LEFT-TRIM

(in-package :cl-test)

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

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

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

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

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

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

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

(deftest string-left-trim.8
  (let* ((s (copy-seq "abcdaba"))
sds's avatar
sds committed
66 67 68 69
         (s2 (string-left-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"
  "cdaba")

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

(deftest string-left-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-left-trim "ab" s)))
88 89 90 91
    (values s s2))
  "abcdaba"
  "cdaba")

92 93
(deftest string-left-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-left-trim "ab" s)))
97 98 99 100 101 102
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-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-left-trim "ab" s)))
107 108 109 110
    (values s s2))
  "abcdaba"
  "cdaba")

111
(deftest string-left-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-left-trim "ab" s)))
116 117 118 119 120
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-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-left-trim "ab" s)))
125 126 127
    (values s s2))
  "abcdaba"
  "cdaba")
128 129 130 131

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

(deftest string-left-trim.14
  (let* ((s '|abcdaba|)
sds's avatar
sds committed
138
         (s2 (string-left-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
    (values (symbol-name s) s2))
  "abcdaba"
  "cdaba")

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

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

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

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

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

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

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

173 174
(deftest string-left-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-left-trim "ab" s) s))
  "caeb" "abcaeb")

(deftest string-left-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-left-trim "ab" s) s))
  "caeb" "abcaeb")

(deftest string-left-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-left-trim "ab" s) s s0))
  "ca" "bca" "abcaeb")

(deftest string-left-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 207
    (values (string-left-trim "ab" s) s s0))
  "ca" "bca" "abcaeb")


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

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

219 220 221
;;; Error cases

(deftest string-left-trim.error.1
222 223
  (signals-error (string-left-trim) program-error)
  t)
224 225

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

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