case.lsp 3.69 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 19:56:44 2002
;;;; Contains: Tests of CASE

(in-package :cl-test)

(deftest case.1
  (case 'a)
  nil)

(deftest case.2
  (case 10 (10 'a))
  a)

(deftest case.3
  (case (copy-seq "abc") ("abc" 'a))
  nil)

(deftest case.4
  (case 'z ((a b c) 1)
sds's avatar
sds committed
22 23 24
           ((d e) 2)
           ((f z g) 3)
           (t 4))
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
  3)

(deftest case.5
  (case (1+ most-positive-fixnum)
    (#.(1+ most-positive-fixnum) 'a))
  a)

(deftest case.6
  (case nil (nil 'a) (t 'b))
  b)

(deftest case.7
  (case nil ((nil) 'a) (t 'b))
  a)

(deftest case.8
  (case 'a (b 0) (a (values 1 2 3)) (t nil))
  1 2 3)

(deftest case.9
  (case 'c (b 0) (a (values 1 2 3)) (t (values 'x 'y 'z)))
  x y z)

(deftest case.10
  (case 'z (b 1) (a 2) (z (values)) (t nil)))

(deftest case.11
  (case 'z (b 1) (a 2) (t (values))))

(deftest case.12
  (case t (a 10))
  nil)

(deftest case.13
  (case t ((t) 10) (t 20))
  10)

(deftest case.14
  (let ((x (list 'a 'b)))
    (eval `(case (quote ,x) ((,x) 1) (t 2))))
  1)

(deftest case.15
  (case 'otherwise ((t) 10))
  nil)

(deftest case.16
  (case t ((otherwise) 10))
  nil)

(deftest case.17
  (case 'a (b 0) (c 1) (otherwise 2))
  2)

(deftest case.18
  (case 'a (b 0) (c 1) ((otherwise) 2))
  nil)

(deftest case.19
  (case 'a (b 0) (c 1) ((t) 2))
  nil)

(deftest case.20
  (case #\a
    ((#\b #\c) 10)
    ((#\d #\e #\A) 20)
    (() 30)
    ((#\z #\a #\y) 40))
  40)

pfdietz's avatar
pfdietz committed
95
(deftest case.21 (case 1 (1 (values))))
96

pfdietz's avatar
pfdietz committed
97
(deftest case.22 (case 2 (t (values))))
98

pfdietz's avatar
pfdietz committed
99 100
(deftest case.23 (case 1 (1 (values 'a 'b 'c)))
  a b c)
101

pfdietz's avatar
pfdietz committed
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
(deftest case.24 (case 2 (t (values 'a 'b 'c)))
  a b c)

;;; Show that the key expression is evaluated only once.
(deftest case.25
  (let ((x 0))
    (values
     (case (progn (incf x) 'c)
       (a 1)
       (b 2)
       (c 3)
       (t 4))
     x))
  3 1)

;;; Repeated keys are allowed (all but the first are ignored)

(deftest case.26
  (case 'b ((a b c) 10) (b 20))
  10)

(deftest case.27
  (case 'b (b 20) ((a b c) 10))
  20)

(deftest case.28
  (case 'b (b 20) (b 10) (t 0))
  20)

;;; There are implicit progns

(deftest case.29
  (let ((x nil))
    (values
     (case 2
       (1 (setq x 'a) 'w)
       (2 (setq x 'b) 'y)
       (t (setq x 'c) 'z))
     x))
  y b)

(deftest case.30
  (let ((x nil))
    (values
     (case 10
       (1 (setq x 'a) 'w)
       (2 (setq x 'b) 'y)
       (t (setq x 'c) 'z))
     x))
  z c)

(deftest case.31
  (case (values 'b 'c) (c 0) ((a b) 10) (t 20))
  10)
156 157 158 159 160 161 162 163 164 165 166 167 168

(deftest case.32
  (case 'a (a) (t 'b))
  nil)

(deftest case.33
  (case 'a (b 'b) (t))
  nil)

(deftest case.34
  (case 'a (b 'b) (otherwise))
  nil)

169 170 171 172 173
;;; No implicit tagbody
(deftest case.35
  (block done
    (tagbody
     (case 'a (a (go 10)
sds's avatar
sds committed
174 175
                 10
                 (return-from done 'bad)))
176 177 178 179 180 181 182 183 184 185
     10
     (return-from done 'good)))
  good)

(deftest case.36
  (block done
    (tagbody
     (case 'b
       (a 'bad)
       (otherwise (go 10)
sds's avatar
sds committed
186 187
                  10
                  (return-from done 'bad)))
188 189 190 191
     10
     (return-from done 'good)))
  good)

192 193 194 195 196 197 198
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest case.37
  (macrolet
   ((%m (z) z))
   (case (expand-in-current-env (%m :b))
sds's avatar
sds committed
199 200 201 202
         (:a :bad1)
         (:b :good)
         (:c :bad2)
         (t :bad3)))
203
  :good)
204

205
;;; (deftest case.error.1
206 207
;;;  (signals-error (case) program-error)
;;;  t)
208 209

(deftest case.error.1
210
  (signals-error (funcall (macro-function 'case))
sds's avatar
sds committed
211
                 program-error)
212
  t)
213 214

(deftest case.error.2
215
  (signals-error (funcall (macro-function 'case) '(case t))
sds's avatar
sds committed
216
                 program-error)
217
  t)
218 219

(deftest case.error.3
220
  (signals-error (funcall (macro-function 'case) '(case t) nil nil)
sds's avatar
sds committed
221
                 program-error)
222
  t)