multiple-value-setq.lsp 3.8 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 46 47 48 49 50 51 52 53 54
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 19 07:00:57 2002
;;;; Contains: Tests of MULTIPLE-VALUE-SETQ

(in-package :cl-test)

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

(deftest multiple-value-setq.2
  (let (x)
    (multiple-value-setq (x) (values 1 2))
    x)
  1)

(deftest multiple-value-setq.3
  (let (x)
    (symbol-macrolet ((y x))
      (multiple-value-setq (y) (values 1 2))
    x))
  1)

(deftest multiple-value-setq.4
  (let ((x (list nil)))
    (symbol-macrolet ((y (car x)))
      (multiple-value-setq (y) (values 1 2))
    x))
  (1))

;;; test of order of evaluation
;;; The (INCF I) should be evaluated before the assigned form I.
(deftest multiple-value-setq.5
  (let ((i 0) (x (list nil)))
    (symbol-macrolet ((y (car (progn (incf i) x))))
      (multiple-value-setq (y) i))
    x)
  (1))

(deftest multiple-value-setq.6
  (let ((x (list nil)) z)
    (symbol-macrolet ((y (car x)))
      (multiple-value-setq (y z) (values 1 2)))
    (values x z))
  (1) 2)

(deftest multiple-value-setq.7
  (let ((x (list nil)) (z (list nil)))
    (symbol-macrolet ((y (car x))
sds's avatar
sds committed
55
                      (w (car z)))
56 57 58 59 60 61 62 63 64
      (multiple-value-setq (y w) (values 1 2)))
    (values x z))
  (1) (2))

;;; Another order of evaluation tests, this time with two
;;; symbol macro arguments
(deftest multiple-value-setq.8
  (let ((x (list nil)) (z (list nil)) (i 0))
    (symbol-macrolet ((y (car (progn (incf i 3) x)))
sds's avatar
sds committed
65
                      (w (car (progn (incf i i) z))))
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
      (multiple-value-setq (y w) (values i 10)))
    (values x z))
  (6) (10))

(deftest multiple-value-setq.9
  (let (x)
    (values
     (multiple-value-setq (x x) (values 1 2))
     x))
  1 2)

(deftest multiple-value-setq.10
  (let (x)
    (values
     (multiple-value-setq (x x) (values 1))
     x))
  1 nil)

(deftest multiple-value-setq.11
  (let ((x 1) (y 2) (z 3))
    (multiple-value-setq (x y z) (values))
    (values x y z))
  nil nil nil)

90

91 92
(deftest multiple-value-setq.12
  (let ((n (min 100 multiple-values-limit))
sds's avatar
sds committed
93 94
        (vars nil)
        (result nil))
95 96 97 98 99 100 101
    (loop
     for i from 1 below n
     for form =
     (progn
       (push (gensym) vars)
       (push i result)
       `(let ,vars
sds's avatar
sds committed
102 103 104 105
          (and (eql (multiple-value-setq ,vars (values-list (quote ,result)))
                    ,(car result))
               (equal ,(make-list-expr vars)
                      (quote ,result)))))
106 107 108
     unless (eval form)
     collect (list i form)))
  nil)
109

110 111 112 113
(deftest multiple-value-setq.13
  (multiple-value-setq nil :good)
  :good)

114 115 116 117 118 119 120 121
(deftest multiple-value-setq.14
  (multiple-value-setq nil (values))
  nil)

(deftest multiple-value-setq.15
  (multiple-value-setq nil (values 'a 'b))
  a)

122 123 124 125 126 127 128 129
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest multiple-value-setq.16
  (macrolet
   ((%m (z) z))
   (let ((x :bad))
     (symbol-macrolet ((z (expand-in-current-env (%m x))))
sds's avatar
sds committed
130
                      (multiple-value-setq (z) :good))
131 132 133 134 135 136 137 138 139 140 141 142
     x))
  :good)

(deftest multiple-value-setq.17
  (macrolet
   ((%m (z) z))
   (let ((x :bad))
     (values
      (multiple-value-setq (x) (expand-in-current-env (%m :good)))
      x)))
  :good :good)

143 144
;;; Error tests

145
(deftest multiple-value-setq.error.1
146
  (signals-error (funcall (macro-function 'multiple-value-setq))
sds's avatar
sds committed
147
                 program-error)
148
  t)
sds's avatar
sds committed
149

150
(deftest multiple-value-setq.error.2
151
  (signals-error (funcall (macro-function 'multiple-value-setq)
sds's avatar
sds committed
152 153
                           '(multiple-value-setq nil nil))
                 program-error)
154
  t)
155 156

(deftest multiple-value-setq.error.3
157
  (signals-error (funcall (macro-function 'multiple-value-setq)
sds's avatar
sds committed
158 159 160
                           '(multiple-value-setq nil nil)
                           nil nil)
                 program-error)
161 162
  t)

sds's avatar
sds committed
163