when.lsp 1.49 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 19:36:57 2002
;;;; Contains: Tests of WHEN

6

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

(deftest when.1
  (when t)
  nil)

(deftest when.2
  (when nil 'a)
  nil)

(deftest when.3 (when t (values)))

(deftest when.4
  (when t (values 'a 'b 'c 'd))
  a b c d)

(deftest when.5
 (when nil (values))
 nil)

(deftest when.6
  (when nil (values 'a 'b 'c 'd))
  nil)

(deftest when.7
  (let ((x 0))
    (values
     (when t (incf x) 'a)
     x))
  a 1)

37 38 39 40 41 42 43 44 45 46 47 48
;;; No implicit tagbody
(deftest when.8
  (block done
    (tagbody
     (when t
       (go 10)
       10
       (return-from done 'bad))
     10
     (return-from done 'good)))
  good)

49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest when.9
  (macrolet
   ((%m (z) z))
   (when (expand-in-current-env (%m t)) :good))
  :good)

(deftest when.10
  (macrolet
   ((%m (z) z))
   (when (expand-in-current-env (%m nil)) :bad))
  nil)

(deftest when.11
  (macrolet
   ((%m (z) z))
   (let ((x t))
     (values (when x (expand-in-current-env (%m (setf x 'foo)))) x)))
  foo foo)

71
;;; Error tests
72 73

(deftest when.error.1
74 75
  (signals-error (funcall (macro-function 'when)) program-error)
  t)
76 77

(deftest when.error.2
78
  (signals-error (funcall (macro-function 'when)
sds's avatar
sds committed
79 80
                           '(when t))
                 program-error)
81
  t)
82 83

(deftest when.error.3
84
  (signals-error (funcall (macro-function 'when)
sds's avatar
sds committed
85 86
                           '(when t) nil nil)
                 program-error)
87
  t)