nstring-upcase.lsp 5 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Oct  3 21:12:40 2002
;;;; Contains: Tests for NSTRING-UPCASE

(in-package :cl-test)

(deftest nstring-upcase.1
  (let* ((s (copy-seq "a"))
sds's avatar
sds committed
10
         (s2 (nstring-upcase s)))
11
    (values (eqt s s2) s))
12 13 14 15
  t "A")

(deftest nstring-upcase.2
  (let* ((s (copy-seq "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
sds's avatar
sds committed
16
         (s2 (nstring-upcase s)))
17
    (values (eqt s s2) s))
18
  t
sds's avatar
sds committed
19
  "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ")
20 21 22

(deftest nstring-upcase.3
  (let* ((s (copy-seq "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ "))
sds's avatar
sds committed
23
         (s2 (nstring-upcase s)))
24
    (values (eqt s s2) s))
25 26 27 28 29
  t
  "0123456789!@#$%^&*()_-+=|\\{}[]:\";'<>?,./ ")

(deftest nstring-upcase.6
  (let* ((s (make-array 6 :element-type 'character
sds's avatar
sds committed
30 31
                        :initial-contents '(#\a #\b #\c #\d #\e #\f)))
         (s2 (nstring-upcase s)))
32
    (values (eqt s s2) s))
33 34 35 36
  t "ABCDEF")

(deftest nstring-upcase.7
  (let* ((s (make-array 6 :element-type 'standard-char
sds's avatar
sds committed
37 38
                        :initial-contents '(#\a #\b #\7 #\d #\e #\f)))
         (s2 (nstring-upcase s)))
39
    (values (eqt s s2) s))
40 41 42 43 44 45 46
  t "AB7DEF")

;; Tests with :start, :end

(deftest nstring-upcase.8
  (let ((s "abcdef"))
    (loop for i from 0 to 6
sds's avatar
sds committed
47
          collect (nstring-upcase (copy-seq s) :start i)))
48 49 50 51 52
  ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef"))

(deftest nstring-upcase.9
  (let ((s "abcdef"))
    (loop for i from 0 to 6
sds's avatar
sds committed
53 54
          collect
          (nstring-upcase (copy-seq s) :start i :end nil)))
55 56 57 58 59
  ("ABCDEF" "aBCDEF" "abCDEF" "abcDEF" "abcdEF" "abcdeF" "abcdef"))

(deftest nstring-upcase.10
  (let ((s "abcde"))
     (loop for i from 0 to 4
sds's avatar
sds committed
60 61 62
           collect (loop for j from i to 5
                         collect (nstring-upcase (copy-seq s)
                                                 :start i :end j))))
63 64 65 66 67 68
  (("abcde" "Abcde" "ABcde" "ABCde" "ABCDe" "ABCDE")
   ("abcde" "aBcde" "aBCde" "aBCDe" "aBCDE")
   ("abcde" "abCde" "abCDe" "abCDE")
   ("abcde" "abcDe" "abcDE")
   ("abcde" "abcdE")))

69
(deftest nstring-upcase.11
70
  :notes (:nil-vectors-are-strings)
71 72 73
  (nstring-upcase (make-array '(0) :element-type nil))
  "")

74 75
(deftest nstring-upcase.12
  (loop for type in '(standard-char base-char character)
sds's avatar
sds committed
76 77 78 79 80 81 82 83
        for s = (make-array '(10) :element-type type
                            :fill-pointer 5
                            :initial-contents "aB0cDefGHi")
        collect (list (copy-seq s)
                      (copy-seq (nstring-upcase s))
                      (copy-seq s)
                      (progn (setf (fill-pointer s) 10) (copy-seq s))
                      ))
84 85 86 87 88 89
  (("aB0cD" "AB0CD" "AB0CD" "AB0CDefGHi")
   ("aB0cD" "AB0CD" "AB0CD" "AB0CDefGHi")
   ("aB0cD" "AB0CD" "AB0CD" "AB0CDefGHi")))

(deftest nstring-upcase.13
  (loop for type in '(standard-char base-char character)
sds's avatar
sds committed
90 91 92 93 94 95 96 97 98
        for s0 = (make-array '(10) :element-type type
                             :initial-contents "zZaB0cDefG")
        for s = (make-array '(5) :element-type type
                            :displaced-to s0
                            :displaced-index-offset 2)
        collect (list (copy-seq s)
                      (nstring-upcase s)
                      (copy-seq s)
                      s0))
99 100 101 102 103 104
  (("aB0cD" "AB0CD" "AB0CD" "zZAB0CDefG")
   ("aB0cD" "AB0CD" "AB0CD" "zZAB0CDefG")
   ("aB0cD" "AB0CD" "AB0CD" "zZAB0CDefG")))

(deftest nstring-upcase.14
  (loop for type in '(standard-char base-char character)
sds's avatar
sds committed
105 106 107 108 109 110
        for s = (make-array '(5) :element-type type
                            :adjustable t
                            :initial-contents "aB0cD")
        collect (list (copy-seq s)
                      (nstring-upcase s)
                      (copy-seq s)))
111 112 113 114 115 116
  (("aB0cD" "AB0CD" "AB0CD")
   ("aB0cD" "AB0CD" "AB0CD")
   ("aB0cD" "AB0CD" "AB0CD")))

;;; Order of evaluation tests

117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
(deftest nstring-upcase.order.1
  (let ((i 0) a b c (s (copy-seq "abcdef")))
    (values
     (nstring-upcase
      (progn (setf a (incf i)) s)
      :start (progn (setf b (incf i)) 1)
      :end   (progn (setf c (incf i)) 4))
     i a b c))
  "aBCDef" 3 1 2 3)

(deftest nstring-upcase.order.2
  (let ((i 0) a b c (s (copy-seq "abcdef")))
    (values
     (nstring-upcase
      (progn (setf a (incf i)) s)
      :end   (progn (setf b (incf i)) 4)
      :start (progn (setf c (incf i)) 1))
     i a b c))
  "aBCDef" 3 1 2 3)

sds's avatar
sds committed
137

138 139 140
;;; Error cases

(deftest nstring-upcase.error.1
141 142
  (signals-error (nstring-upcase) program-error)
  t)
143 144

(deftest nstring-upcase.error.2
145 146
  (signals-error (nstring-upcase (copy-seq "abc") :bad t) program-error)
  t)
147 148

(deftest nstring-upcase.error.3
149 150
  (signals-error (nstring-upcase (copy-seq "abc") :start) program-error)
  t)
151 152

(deftest nstring-upcase.error.4
153
  (signals-error (nstring-upcase (copy-seq "abc") :bad t
sds's avatar
sds committed
154 155
                                      :allow-other-keys nil)
                 program-error)
156
  t)
157 158

(deftest nstring-upcase.error.5
159 160
  (signals-error (nstring-upcase (copy-seq "abc") :end) program-error)
  t)
161 162

(deftest nstring-upcase.error.6
163 164 165
  (signals-error (nstring-upcase (copy-seq "abc") 1 2) program-error)
  t)