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