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

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

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

File size: 4.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Oct  1 07:51:00 2002
4;;;; Contains: Tests for STRING-UPCASE
5
6(in-package :cl-test)
7
8(deftest string-upcase.1
9  (let ((s "a"))
10    (values (string-upcase s) s))
11  "A" "a")
12
13(deftest string-upcase.2
14  (let ((s "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
15    (values (string-upcase s) s))
16  "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ"
17  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
18
19(deftest string-upcase.3
20  (let ((s "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ "))
21    (values (string-upcase s) s))
22  "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ "
23  "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ")
24
25(deftest string-upcase.4
26  (string-upcase #\a)
27  "A")
28
29(deftest string-upcase.5
30  (let ((sym '|a|))
31    (values (string-upcase sym) sym))
32  "A" |a|)
33
34(deftest string-upcase.6
35  (let ((s (make-array 6 :element-type 'character
36                       :initial-contents '(#\a #\b #\c #\d #\e #\f))))
37    (values (string-upcase s) s))
38  "ABCDEF"
39  "abcdef")
40
41(deftest string-upcase.7
42  (let ((s (make-array 6 :element-type 'standard-char
43                       :initial-contents '(#\a #\b #\7 #\d #\e #\f))))
44    (values (string-upcase s) s))
45  "AB7DEF"
46  "ab7def")
47
48;; Tests with :start, :end
49
50(deftest string-upcase.8
51  (let ((s "abcdef"))
52    (values
53     (loop for i from 0 to 6
54           collect (string-upcase s :start i))
55     s))
56  ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef")
57  "abcdef")
58
59(deftest string-upcase.9
60  (let ((s "abcdef"))
61    (values
62      (loop for i from 0 to 6
63            collect
64            (string-upcase s :start i :end nil))
65      s))
66  ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef")
67  "abcdef")
68
69(deftest string-upcase.10
70  (let ((s "abcde"))
71    (values
72     (loop for i from 0 to 4
73           collect (loop for j from i to 5
74                         collect (string-upcase s :start i :end j)))
75     s))
76  (("abcde" "Abcde" "ABcde" "ABCde" "ABCDe" "ABCDE")
77   ("abcde" "aBcde" "aBCde" "aBCDe" "aBCDE")
78   ("abcde" "abCde" "abCDe" "abCDE")
79   ("abcde" "abcDe" "abcDE")
80   ("abcde" "abcdE"))
81  "abcde")
82
83(deftest string-upcase.11
84  :notes (:nil-vectors-are-strings)
85  (string-upcase (make-array '(0) :element-type nil))
86  "")
87
88(deftest string-upcase.12
89  (loop for type in '(standard-char base-char character)
90        for s = (make-array '(10) :element-type type
91                            :fill-pointer 5
92                            :initial-contents "aB0cDefGHi")
93        collect (list s (string-upcase s)))
94  (("aB0cD" "AB0CD") ("aB0cD" "AB0CD") ("aB0cD" "AB0CD")))
95
96
97(deftest string-upcase.13
98  (loop for type in '(standard-char base-char character)
99        for s0 = (make-array '(10) :element-type type
100                             :initial-contents "zZaB0cDefG")
101        for s = (make-array '(5) :element-type type
102                            :displaced-to s0
103                            :displaced-index-offset 2)
104        collect (list s (string-upcase s)))
105  (("aB0cD" "AB0CD") ("aB0cD" "AB0CD") ("aB0cD" "AB0CD")))
106
107(deftest string-upcase.14
108  (loop for type in '(standard-char base-char character)
109        for s = (make-array '(5) :element-type type
110                            :adjustable t
111                            :initial-contents "aB0cD")
112        collect (list s (string-upcase s)))
113  (("aB0cD" "AB0CD") ("aB0cD" "AB0CD") ("aB0cD" "AB0CD")))
114
115;;; Order of evaluation tests
116
117(deftest string-upcase.order.1
118  (let ((i 0) a b c (s (copy-seq "abcdef")))
119    (values
120     (string-upcase
121      (progn (setf a (incf i)) s)
122      :start (progn (setf b (incf i)) 1)
123      :end   (progn (setf c (incf i)) 4))
124     i a b c))
125  "aBCDef" 3 1 2 3)
126
127(deftest string-upcase.order.2
128  (let ((i 0) a b c (s (copy-seq "abcdef")))
129    (values
130     (string-upcase
131      (progn (setf a (incf i)) s)
132      :end   (progn (setf b (incf i)) 4)
133      :start (progn (setf c (incf i)) 1))
134     i a b c))
135  "aBCDef" 3 1 2 3)
136
137;;; Const fold tests
138
139(def-fold-test string-upcase.fold.1 (string-upcase "abcde"))
140 
141;;; Error tests
142
143(deftest string-upcase.error.1
144  (signals-error (string-upcase) program-error)
145  t)
146
147(deftest string-upcase.error.2
148  (signals-error (string-upcase (copy-seq "abc") :bad t) program-error)
149  t)
150
151(deftest string-upcase.error.3
152  (signals-error (string-upcase (copy-seq "abc") :start) program-error)
153  t)
154
155(deftest string-upcase.error.4
156  (signals-error (string-upcase (copy-seq "abc") :bad t
157                                      :allow-other-keys nil) program-error)
158  t)
159
160(deftest string-upcase.error.5
161  (signals-error (string-upcase (copy-seq "abc") :end) program-error)
162  t)
163
164(deftest string-upcase.error.6
165  (signals-error (string-upcase (copy-seq "abc") 1 2) program-error)
166  t)
Note: See TracBrowser for help on using the repository browser.