cond.lsp 1.87 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 07:37:58 2002
;;;; Contains: Tests of COND

6

pfdietz's avatar
pfdietz committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42

(deftest cond.1
  (cond)
  nil)

(deftest cond.2
  (cond ('a))
  a)

(deftest cond.3
  (cond (nil))
  nil)

(deftest cond.4
  (cond (nil 'a) (nil 'b))
  nil)

(deftest cond.5
  (cond (nil 'a) ('b))
  b)

(deftest cond.6
  (cond (t 'a) (t 'b))
  a)

(deftest cond.7
  (let ((x 0))
    (values
     (cond ((progn (incf x) nil) 'a) (t 'b) ((incf x) 'c))
     x))
  b 1)

(deftest cond.8
  (let ((x 0))
    (values
     (cond (nil (incf x) 'a)
sds's avatar
sds committed
43 44 45
           (nil (incf x 10) 'b)
           (t (incf x 2) 'c)
           (t (incf x 100) 'd))
pfdietz's avatar
pfdietz committed
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
     x))
  c 2)

(deftest cond.9
  (cond ((values 'a 'b 'c)))
  a)

(deftest cond.10
  (cond (t (values 'a 'b 'c)))
  a b c)

(deftest cond.11
  (cond
   ((values nil t) 'a)
   (t 'b))
  b)

(deftest cond.12
  (cond ((values)))
  nil)

(deftest cond.13
  (cond ((values)) (t 'a))
  a)

(deftest cond.14 (cond (t (values))))

73 74 75 76 77
;;; No implicit tagbody
(deftest cond.15
  (block done
    (tagbody
     (cond (t (go 10)
sds's avatar
sds committed
78 79
              10
              (return-from done 'bad)))
80 81 82
     10
     (return-from done 'good)))
  good)
83

84 85 86 87 88 89 90
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest cond.16
  (macrolet
   ((%m (z) z))
   (cond ((expand-in-current-env (%m nil)) :bad)
sds's avatar
sds committed
91
         (t :good)))
92 93 94 95 96 97
  :good)

(deftest cond.17
  (macrolet
   ((%m (z) z))
   (cond (nil :bad1)
sds's avatar
sds committed
98 99
         ((expand-in-current-env (%m :good)))
         (t :bad2)))
100 101 102 103
  :good)

;;; Error tests

104
(deftest cond.error.1
105
  (signals-error (funcall (macro-function 'cond))
sds's avatar
sds committed
106
                 program-error)
107
  t)
108 109

(deftest cond.error.2
110
  (signals-error (funcall (macro-function 'cond) '(cond))
sds's avatar
sds committed
111
                 program-error)
112
  t)
113 114

(deftest cond.error.3
115
  (signals-error (funcall (macro-function 'cond) '(cond) nil nil)
sds's avatar
sds committed
116
                 program-error)
117 118
  t)