when.lsp 1.51 KB
Newer Older
1
2
3
4
5
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
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 19:36:57 2002
;;;; Contains: Tests of WHEN

(in-package :cl-test)

(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)