multiple-value-bind.lsp 2.74 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 37 38 39 40 41 42 43 44 45
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 23:16:23 2002
;;;; Contains: Tests for MULTIPLE-VALUE-BIND

(in-package :cl-test)

(deftest multiple-value-bind.1
  (multiple-value-bind (x y z) (values 1 2 3)
    (declare (type integer x))
    (declare (type integer y))
    (declare (type integer z))
    (list z y x))
  (3 2 1))

(deftest multiple-value-bind.2
  (multiple-value-bind (x y z) (values 1 2 3)
    (let ((x 4))
      (list x y z)))
  (4 2 3))

(deftest multiple-value-bind.3
  (multiple-value-bind (x y z) (values 1 2 3 4 5 6)
    (list x y z))
  (1 2 3))

(deftest multiple-value-bind.4
  (multiple-value-bind (x y z) (values 1 2)
    (list x y z))
  (1 2 nil))

(deftest multiple-value-bind.5
  (multiple-value-bind () (values 1 2) (values 'a 'b 'c))
  a b c)

(deftest multiple-value-bind.6
  (multiple-value-bind (x y z) (values)
    (list x y z))
  (nil nil nil))

(deftest multiple-value-bind.7
  (let ((z 0) x y)
    (declare (special z))
    (values
     (flet ((%x () (symbol-value 'x))
sds's avatar
sds committed
46 47
            (%y () (symbol-value 'y))
            (%z () (symbol-value 'z)))
48
       (multiple-value-bind (x y z) (values 1 2 3)
sds's avatar
sds committed
49 50
         (declare (special x y))
         (list (%x) (%y) (%z))))
51 52 53
     x y z))
  (1 2 0) nil nil 0)

54 55 56 57 58 59 60 61 62 63 64 65
;;; No implicit tagbody
(deftest multiple-value-bind.8
  (block nil
    (tagbody
     (multiple-value-bind (x) nil
       (go 10)
       10
       (return 'bad))
     10
     (return 'good)))
  good)

66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
;;; Works with single values
(deftest multiple-value-bind.9
  (multiple-value-bind (x y z) :foo (list x y z))
  (:foo nil nil))

(deftest multiple-value-bind.10
  (multiple-value-bind (x) :foo x)
  :foo)

(deftest multiple-value-bind.11
  (multiple-value-bind () :foo)
  nil)

(deftest multiple-value-bind.12
  (multiple-value-bind () (values))
  nil)

(deftest multiple-value-bind.13
  (multiple-value-bind () (values 1 2 3 4 5))
  nil)

87 88 89 90 91 92 93
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest multiple-value-bind.14
  (macrolet
   ((%m (z) z))
   (multiple-value-bind (x y z)
sds's avatar
sds committed
94 95
                        (expand-in-current-env (%m (values 1 2 3)))
                        (list x y z)))
96 97
  (1 2 3))

98 99
;;; Error cases

100
(deftest multiple-value-bind.error.1
101
  (signals-error (funcall (macro-function 'multiple-value-bind))
sds's avatar
sds committed
102
                 program-error)
103
  t)
sds's avatar
sds committed
104

105
(deftest multiple-value-bind.error.2
106
  (signals-error (funcall (macro-function 'multiple-value-bind)
sds's avatar
sds committed
107 108
                           '(multiple-value-bind nil nil))
                 program-error)
109
  t)
110 111

(deftest multiple-value-bind.error.3
112
  (signals-error (funcall (macro-function 'multiple-value-bind)
sds's avatar
sds committed
113 114 115
                           '(multiple-value-bind nil nil)
                           nil nil)
                 program-error)
116
  t)