source: trunk/source/tests/ansi-tests/string-right-trim.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 5.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Oct  4 04:59:46 2002
4;;;; Contains: Tests of STRING-RIGHT-TRIM
5
6(in-package :cl-test)
7
8(deftest string-right-trim.1
9  (let* ((s (copy-seq "abcdaba"))
10         (s2 (string-right-trim "ab" s)))
11    (values s s2))
12  "abcdaba"
13  "abcd")
14
15(deftest string-right-trim.2
16  (let* ((s (copy-seq "abcdaba"))
17         (s2 (string-right-trim '(#\a #\b) s)))
18    (values s s2))
19  "abcdaba"
20  "abcd")
21
22(deftest string-right-trim.3
23  (let* ((s (copy-seq "abcdaba"))
24         (s2 (string-right-trim #(#\a #\b) s)))
25    (values s s2))
26  "abcdaba"
27  "abcd")
28
29(deftest string-right-trim.4
30  (let* ((s (copy-seq "abcdaba"))
31         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b))
32                          s)))
33    (values s s2))
34  "abcdaba"
35  "abcd")
36
37(deftest string-right-trim.5
38  (let* ((s (copy-seq "abcdaba"))
39         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)
40                                      :element-type 'character)
41                          s)))
42    (values s s2))
43  "abcdaba"
44  "abcd")
45
46(deftest string-right-trim.6
47  (let* ((s (copy-seq "abcdaba"))
48         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)
49                                      :element-type 'standard-char)
50                          s)))
51    (values s s2))
52  "abcdaba"
53  "abcd")
54
55(deftest string-right-trim.7
56  (let* ((s (copy-seq "abcdaba"))
57         (s2 (string-right-trim (make-array 2 :initial-contents '(#\a #\b)
58                                      :element-type 'base-char)
59                          s)))
60    (values s s2))
61  "abcdaba"
62  "abcd")
63
64(deftest string-right-trim.8
65  (let* ((s (copy-seq "abcdaba"))
66         (s2 (string-right-trim (make-array 4 :initial-contents '(#\a #\b #\c #\d)
67                                      :element-type 'character
68                                      :fill-pointer 2)
69                          s)))
70    (values s s2))
71  "abcdaba"
72  "abcd")
73
74(deftest string-right-trim.9
75  (let* ((s (make-array 7 :initial-contents "abcdaba"
76                        :element-type 'character
77                        ))
78         (s2 (string-right-trim "ab" s)))
79    (values s s2))
80  "abcdaba"
81  "abcd")
82
83(deftest string-right-trim.10
84  (let* ((s (make-array 9 :initial-contents "abcdabadd"
85                        :element-type 'character
86                        :fill-pointer 7))
87         (s2 (string-right-trim "ab" s)))
88    (values s s2))
89  "abcdaba"
90  "abcd")
91
92(deftest string-right-trim.10a
93  (let* ((s (make-array 9 :initial-contents "abcdabadd"
94                        :element-type 'base-char
95                        :fill-pointer 7))
96         (s2 (string-right-trim "ab" s)))
97    (values s s2))
98  "abcdaba"
99  "abcd")
100
101(deftest string-right-trim.10b
102  (let* ((s (make-array 9 :initial-contents "abcdabadd"
103                        :element-type 'base-char
104                        :adjustable t
105                        :fill-pointer 7))
106         (s2 (string-right-trim "ab" s)))
107    (values s s2))
108  "abcdaba"
109  "abcd")
110
111(deftest string-right-trim.11
112  (let* ((s (make-array 7 :initial-contents "abcdaba"
113                        :element-type 'standard-char
114                        ))
115         (s2 (string-right-trim "ab" s)))
116    (values s s2))
117  "abcdaba"
118  "abcd")
119
120(deftest string-right-trim.12
121  (let* ((s (make-array 7 :initial-contents "abcdaba"
122                        :element-type 'base-char
123                        ))
124         (s2 (string-right-trim "ab" s)))
125    (values s s2))
126  "abcdaba"
127  "abcd")
128
129;;; Test that trimming is case sensitive
130(deftest string-right-trim.13
131  (let* ((s (copy-seq "Aa"))
132         (s2 (string-right-trim "a" s)))
133    (values s s2))
134  "Aa" "A")
135
136(deftest string-right-trim.14
137  (let* ((s '|abcdaba|)
138         (s2 (string-right-trim "ab" s)))
139    (values (symbol-name s) s2))
140  "abcdaba"
141  "abcd")
142
143(deftest string-right-trim.15
144  (string-right-trim "abc" "")
145  "")
146
147(deftest string-right-trim.16
148  (string-right-trim "a" #\a)
149  "")
150
151(deftest string-right-trim.17
152  (string-right-trim "b" #\a)
153  "a")
154
155(deftest string-right-trim.18
156  (string-right-trim "" (copy-seq "abcde"))
157  "abcde")
158
159(deftest string-right-trim.19
160  (string-right-trim "abc" (copy-seq "abcabcabc"))
161  "")
162
163(deftest string-right-trim.20
164  :notes (:nil-vectors-are-strings)
165  (string-right-trim "abcd" (make-array '(0) :element-type nil))
166  "")
167
168(deftest string-right-trim.21
169  :notes (:nil-vectors-are-strings)
170  (string-right-trim (make-array '(0) :element-type nil) "abcd")
171  "abcd")
172
173(deftest string-right-trim.22
174  (let ((s (make-array '(6) :initial-contents "abcaeb"
175                       :element-type 'base-char
176                       :adjustable t)))
177    (values (string-right-trim "ab" s) s))
178  "abcae" "abcaeb")
179
180(deftest string-right-trim.23
181  (let ((s (make-array '(6) :initial-contents "abcaeb"
182                       :element-type 'character
183                       :adjustable t)))
184    (values (string-right-trim "ab" s) s))
185  "abcae" "abcaeb")
186
187(deftest string-right-trim.24
188  (let* ((etype 'base-char)
189         (s0 (make-array '(6) :initial-contents "abcaeb"
190                         :element-type etype))
191         (s (make-array '(3) :element-type etype
192                        :displaced-to s0
193                        :displaced-index-offset 1)))
194    (values (string-right-trim "ab" s) s s0))
195  "bc" "bca" "abcaeb")
196
197(deftest string-right-trim.25
198  (let* ((etype 'character)
199         (s0 (make-array '(6) :initial-contents "abcaeb"
200                         :element-type etype))
201         (s (make-array '(3) :element-type etype
202                        :displaced-to s0
203                        :displaced-index-offset 1)))
204    (values (string-right-trim "ab" s) s s0))
205  "bc" "bca" "abcaeb")
206
207(deftest string-right-trim.order.1
208  (let ((i 0) x y)
209    (values
210     (string-right-trim (progn (setf x (incf i)) " ")
211                       (progn (setf y (incf i))
212                              (copy-seq "   abc d e f  ")))
213     i x y))
214  "   abc d e f" 2 1 2)
215
216(def-fold-test string-right-trim.fold.1 (string-right-trim " " "abcd "))
217
218;;; Error cases
219
220(deftest string-right-trim.error.1
221  (signals-error (string-right-trim) program-error)
222  t)
223
224(deftest string-right-trim.error.2
225  (signals-error (string-right-trim "abc") program-error)
226  t)
227
228(deftest string-right-trim.error.3
229  (signals-error (string-right-trim "abc" "abcdddabc" nil) program-error)
230  t)
Note: See TracBrowser for help on using the repository browser.