string-left-trim.lsp 3.87 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
;-*- 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"))
	 (s2 (string-left-trim "ab" s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.2
  (let* ((s (copy-seq "abcdaba"))
	 (s2 (string-left-trim '(#\a #\b) s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.3
  (let* ((s (copy-seq "abcdaba"))
	 (s2 (string-left-trim #(#\a #\b) s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.4
  (let* ((s (copy-seq "abcdaba"))
	 (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b))
			  s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.5
  (let* ((s (copy-seq "abcdaba"))
	 (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)
				      :element-type 'character)
			  s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.6
  (let* ((s (copy-seq "abcdaba"))
	 (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)
				      :element-type 'standard-char)
			  s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.7
  (let* ((s (copy-seq "abcdaba"))
	 (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)
				      :element-type 'base-char)
			  s)))
    (values s s2))
  "abcdaba"
  "cdaba")

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

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

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

(deftest string-left-trim.11
93
  (let* ((s (make-array 7 :initial-contents "abcdaba"
94
95
96
97
98
99
100
101
			:element-type 'standard-char
			))
	 (s2 (string-left-trim "ab" s)))
    (values s s2))
  "abcdaba"
  "cdaba")

(deftest string-left-trim.12
102
  (let* ((s (make-array 7 :initial-contents "abcdaba"
103
104
105
106
107
108
			:element-type 'base-char
			))
	 (s2 (string-left-trim "ab" s)))
    (values s s2))
  "abcdaba"
  "cdaba")
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

;;; Test that trimming is case sensitive
(deftest string-left-trim.13
  (let* ((s (copy-seq "aA"))
	 (s2 (string-left-trim "a" s)))
    (values s s2))
  "aA" "A")

(deftest string-left-trim.14
  (let* ((s '|abcdaba|)
	 (s2 (string-left-trim "ab" s)))
    (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"))
  "")
143

144
(deftest string-left-trim.20
145
  :notes (:nil-vectors-are-strings)
146
147
148
149
  (string-left-trim "abcd" (make-array '(0) :element-type nil))
  "")

(deftest string-left-trim.21
150
  :notes (:nil-vectors-are-strings)
151
152
153
  (string-left-trim (make-array '(0) :element-type nil) "abcd")
  "abcd")

154
155
156
157
158
159
160
161
162
(deftest string-left-trim.order.1
  (let ((i 0) x y)
    (values
     (string-left-trim (progn (setf x (incf i)) " ")
		       (progn (setf y (incf i))
			      (copy-seq "   abc d e f  ")))
     i x y))
  "abc d e f  " 2 1 2)

163
164
165
166
167
168
169
170
171
172
173
174
175
;;; Error cases

(deftest string-left-trim.error.1
  (classify-error (string-left-trim))
  program-error)

(deftest string-left-trim.error.2
  (classify-error (string-left-trim "abc"))
  program-error)

(deftest string-left-trim.error.3
  (classify-error (string-left-trim "abc" "abcdddabc" nil))
  program-error)