← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/string-left-trim.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/string-left-trim.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Fri Oct  4 04:57:41 2002
 
4
;;;; Contains: Tests for STRING-LEFT-TRIM
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest string-left-trim.1
 
9
  (let* ((s (copy-seq "abcdaba"))
 
10
         (s2 (string-left-trim "ab" s)))
 
11
    (values s s2))
 
12
  "abcdaba"
 
13
  "cdaba")
 
14
 
 
15
(deftest string-left-trim.2
 
16
  (let* ((s (copy-seq "abcdaba"))
 
17
         (s2 (string-left-trim '(#\a #\b) s)))
 
18
    (values s s2))
 
19
  "abcdaba"
 
20
  "cdaba")
 
21
 
 
22
(deftest string-left-trim.3
 
23
  (let* ((s (copy-seq "abcdaba"))
 
24
         (s2 (string-left-trim #(#\a #\b) s)))
 
25
    (values s s2))
 
26
  "abcdaba"
 
27
  "cdaba")
 
28
 
 
29
(deftest string-left-trim.4
 
30
  (let* ((s (copy-seq "abcdaba"))
 
31
         (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b))
 
32
                          s)))
 
33
    (values s s2))
 
34
  "abcdaba"
 
35
  "cdaba")
 
36
 
 
37
(deftest string-left-trim.5
 
38
  (let* ((s (copy-seq "abcdaba"))
 
39
         (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)
 
40
                                      :element-type 'character)
 
41
                          s)))
 
42
    (values s s2))
 
43
  "abcdaba"
 
44
  "cdaba")
 
45
 
 
46
(deftest string-left-trim.6
 
47
  (let* ((s (copy-seq "abcdaba"))
 
48
         (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)
 
49
                                      :element-type 'standard-char)
 
50
                          s)))
 
51
    (values s s2))
 
52
  "abcdaba"
 
53
  "cdaba")
 
54
 
 
55
(deftest string-left-trim.7
 
56
  (let* ((s (copy-seq "abcdaba"))
 
57
         (s2 (string-left-trim (make-array 2 :initial-contents '(#\a #\b)
 
58
                                      :element-type 'base-char)
 
59
                          s)))
 
60
    (values s s2))
 
61
  "abcdaba"
 
62
  "cdaba")
 
63
 
 
64
(deftest string-left-trim.8
 
65
  (let* ((s (copy-seq "abcdaba"))
 
66
         (s2 (string-left-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
  "cdaba")
 
73
 
 
74
(deftest string-left-trim.9
 
75
  (let* ((s (make-array 7 :initial-contents "abcdaba"
 
76
                        :element-type 'character
 
77
                        ))
 
78
         (s2 (string-left-trim "ab" s)))
 
79
    (values s s2))
 
80
  "abcdaba"
 
81
  "cdaba")
 
82
 
 
83
(deftest string-left-trim.10
 
84
  (let* ((s (make-array 9 :initial-contents "abcdabadd"
 
85
                        :element-type 'character
 
86
                        :fill-pointer 7))
 
87
         (s2 (string-left-trim "ab" s)))
 
88
    (values s s2))
 
89
  "abcdaba"
 
90
  "cdaba")
 
91
 
 
92
(deftest string-left-trim.11
 
93
  (let* ((s (make-array 7 :initial-contents "abcdaba"
 
94
                        :element-type 'standard-char
 
95
                        ))
 
96
         (s2 (string-left-trim "ab" s)))
 
97
    (values s s2))
 
98
  "abcdaba"
 
99
  "cdaba")
 
100
 
 
101
(deftest string-left-trim.12
 
102
  (let* ((s (make-array 7 :initial-contents "abcdaba"
 
103
                        :element-type 'base-char
 
104
                        ))
 
105
         (s2 (string-left-trim "ab" s)))
 
106
    (values s s2))
 
107
  "abcdaba"
 
108
  "cdaba")
 
109
 
 
110
;;; Test that trimming is case sensitive
 
111
(deftest string-left-trim.13
 
112
  (let* ((s (copy-seq "aA"))
 
113
         (s2 (string-left-trim "a" s)))
 
114
    (values s s2))
 
115
  "aA" "A")
 
116
 
 
117
(deftest string-left-trim.14
 
118
  (let* ((s '|abcdaba|)
 
119
         (s2 (string-left-trim "ab" s)))
 
120
    (values (symbol-name s) s2))
 
121
  "abcdaba"
 
122
  "cdaba")
 
123
 
 
124
(deftest string-left-trim.15
 
125
  (string-left-trim "abc" "")
 
126
  "")
 
127
 
 
128
(deftest string-left-trim.16
 
129
  (string-left-trim "a" #\a)
 
130
  "")
 
131
 
 
132
(deftest string-left-trim.17
 
133
  (string-left-trim "b" #\a)
 
134
  "a")
 
135
 
 
136
(deftest string-left-trim.18
 
137
  (string-left-trim "" (copy-seq "abcde"))
 
138
  "abcde")
 
139
 
 
140
(deftest string-left-trim.19
 
141
  (string-left-trim "abc" (copy-seq "abcabcabc"))
 
142
  "")
 
143
 
 
144
(deftest string-left-trim.20
 
145
  :notes (:nil-vectors-are-strings)
 
146
  (string-left-trim "abcd" (make-array '(0) :element-type nil))
 
147
  "")
 
148
 
 
149
(deftest string-left-trim.21
 
150
  :notes (:nil-vectors-are-strings)
 
151
  (string-left-trim (make-array '(0) :element-type nil) "abcd")
 
152
  "abcd")
 
153
 
 
154
(deftest string-left-trim.order.1
 
155
  (let ((i 0) x y)
 
156
    (values
 
157
     (string-left-trim (progn (setf x (incf i)) " ")
 
158
                       (progn (setf y (incf i))
 
159
                              (copy-seq "   abc d e f  ")))
 
160
     i x y))
 
161
  "abc d e f  " 2 1 2)
 
162
 
 
163
;;; Error cases
 
164
 
 
165
(deftest string-left-trim.error.1
 
166
  (signals-error (string-left-trim) program-error)
 
167
  t)
 
168
 
 
169
(deftest string-left-trim.error.2
 
170
  (signals-error (string-left-trim "abc") program-error)
 
171
  t)
 
172
 
 
173
(deftest string-left-trim.error.3
 
174
  (signals-error (string-left-trim "abc" "abcdddabc" nil) program-error)
 
175
  t)