char-schar.lsp 4.32 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Sep 29 21:04:44 2002
;;;; Contains: Tests of CHAR and SCHAR accessors

(in-package :cl-test)

(deftest char.1
  (let ((s "abcd"))
    (values (char s 0) (char s 1) (char s 2) (char s 3)))
  #\a #\b #\c #\d)

(deftest char.2
  (let ((s0 (copy-seq "abcd"))
sds's avatar
sds committed
15 16 17
        (s1 (copy-seq "abcd"))
        (s2 (copy-seq "abcd"))
        (s3 (copy-seq "abcd")))
18 19 20 21 22 23 24 25
    (setf (char s0 0) #\X)
    (setf (char s1 1) #\X)
    (setf (char s2 2) #\X)
    (setf (char s3 3) #\X)
    (values s0 s1 s2 s3))
  "Xbcd" "aXcd" "abXd" "abcX")

(deftest char.3
26
  (let ((s (make-array 6 :element-type 'character
sds's avatar
sds committed
27
                       :initial-contents '(#\a #\b #\c #\d #\e #\f))))
28 29 30 31 32
    (setf (char s 3) #\X)
    s)
  "abcXef")

(deftest char.4
33
  (let ((s (make-array 6 :element-type 'character
sds's avatar
sds committed
34 35
                       :initial-contents '(#\a #\b #\c #\d #\e #\f)
                       :fill-pointer 4)))
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
    (setf (char s 3) #\X)
    s)
  "abcX")

(deftest char.5
  (let ((s (make-string 5 :initial-element #\a)))
    (setf (char s 3) #\X)
    s)
  "aaaXa")

(deftest char.6
  (let ((s (make-string 5 :initial-element #\a :element-type 'base-char)))
    (setf (char s 3) #\X)
    s)
  "aaaXa")

(deftest char.7
  (let ((s (make-string 5 :initial-element #\a :element-type 'character)))
    (setf (char s 3) #\X)
    s)
  "aaaXa")

(deftest char.8
59
  (let ((s (make-array 6 :element-type 'character
sds's avatar
sds committed
60 61
                       :initial-contents '(#\a #\b #\c #\d #\e #\f)
                       :fill-pointer 4)))
62 63 64
    (setf (char s 5) #\X)
    (setf (fill-pointer s) 6)
    s)
65
  "abcdeX")
66 67 68

(deftest char.9
  (let ((s (make-string 5 :initial-element #\a
sds's avatar
sds committed
69
                        :element-type 'base-char)))
70 71 72 73 74 75
    (setf (char s 3) #\X)
    s)
  "aaaXa")

(deftest char.10
  (let ((s (make-string 5 :initial-element #\a
sds's avatar
sds committed
76
                        :element-type 'standard-char)))
77 78 79 80
    (setf (char s 3) #\X)
    s)
  "aaaXa")

81
(deftest char.order.1
82 83 84
  (let ((i 0) a b)
    (values
     (char (progn (setf a (incf i)) "abc")
sds's avatar
sds committed
85
           (progn (setf b (incf i)) 1))
86 87 88
     i a b))
  #\b 2 1 2)

89
(deftest char.order.2
90 91 92 93
  (let ((i 0) a b c (s (make-string 5 :initial-element #\z)))
    (values
     (setf
      (char (progn (setf a (incf i)) s)
sds's avatar
sds committed
94
            (progn (setf b (incf i)) 1))
95 96 97 98
      (progn (setf c (incf i)) #\a))
     s i a b c))
  #\a "zazzz" 3 1 2 3)

99 100 101 102 103 104 105 106 107 108 109 110 111 112
;;; Error tests

(deftest char.error.1
  (signals-error (char) program-error)
  t)

(deftest char.error.2
  (signals-error (char "abc") program-error)
  t)

(deftest char.error.3
  (signals-error (char "abc" 1 nil) program-error)
  t)

113 114 115 116 117 118 119 120
;;; Tests of schar

(deftest schar.1
  (let ((s "abcd")) (values (schar s 0) (schar s 1) (schar s 2) (schar s 3)))
  #\a #\b #\c #\d)

(deftest schar.2
  (let ((s0 (copy-seq "abcd"))
sds's avatar
sds committed
121 122 123
        (s1 (copy-seq "abcd"))
        (s2 (copy-seq "abcd"))
        (s3 (copy-seq "abcd")))
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
    (setf (schar s0 0) #\X)
    (setf (schar s1 1) #\X)
    (setf (schar s2 2) #\X)
    (setf (schar s3 3) #\X)
    (values s0 s1 s2 s3))
  "Xbcd" "aXcd" "abXd" "abcX")

(deftest schar.3
  (let ((s (make-string 6 :initial-element #\x)))
    (setf (schar s 2) #\X)
    s)
  "xxXxxx")

(deftest schar.4
  (let ((s (make-string 6 :initial-element #\x :element-type 'character)))
    (setf (schar s 2) #\X)
    s)
  "xxXxxx")

(deftest schar.5
144
  (let ((s (make-string 6 :initial-element #\x :element-type 'standard-char)))
145 146 147 148 149 150 151 152 153 154 155 156
    (setf (schar s 2) #\X)
    s)
  "xxXxxx")

(deftest schar.6
  (let ((s (make-string 6 :initial-element #\x :element-type 'base-char)))
    (setf (schar s 2) #\X)
    s)
  "xxXxxx")

(deftest schar.7
  (let ((s (make-string 6 :initial-element #\x
sds's avatar
sds committed
157
                        :element-type 'standard-char)))
158 159 160
    (setf (schar s 2) #\X)
    s)
  "xxXxxx")
161

162
(deftest schar.order.1
163 164 165
  (let ((i 0) a b)
    (values
     (schar (progn (setf a (incf i)) "abc")
sds's avatar
sds committed
166
            (progn (setf b (incf i)) 1))
167 168 169
     i a b))
  #\b 2 1 2)

170
(deftest schar.order.2
171 172 173 174
  (let ((i 0) a b c (s (copy-seq "zzzzz")))
    (values
     (setf
      (schar (progn (setf a (incf i)) s)
sds's avatar
sds committed
175
             (progn (setf b (incf i)) 1))
176 177 178
      (progn (setf c (incf i)) #\a))
     s i a b c))
  #\a "zazzz" 3 1 2 3)
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193

;;; Error tests

(deftest schar.error.1
  (signals-error (schar) program-error)
  t)

(deftest schar.error.2
  (signals-error (schar "abc") program-error)
  t)

(deftest schar.error.3
  (signals-error (schar "abc" 1 nil) program-error)
  t)