multiple-value-prog1.lsp 2.12 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
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 19 06:48:02 2002
;;;; Contains: Tests for MULTIPLE-VALUE-PROG1

(in-package :cl-test)

(deftest multiple-value-prog1.1
  (multiple-value-prog1 nil)
  nil)

(deftest multiple-value-prog1.2
  (multiple-value-prog1 '(a b c))
  (a b c))

(deftest multiple-value-prog1.3
  (multiple-value-prog1 (values-list '(a b c)))
  a b c)

(deftest multiple-value-prog1.4
  (multiple-value-prog1 (values)))

(deftest multiple-value-prog1.5
  (let ((x 0) (y 0))
    (multiple-value-prog1 (values x y)
sds's avatar
sds committed
26
                          (incf x) (incf y 2)))
27 28 29 30 31 32 33
  0 0)

(deftest multiple-value-prog1.6
  (let ((x 0) (y 0))
    (multiple-value-call
     #'list
     (multiple-value-prog1 (values x y)
sds's avatar
sds committed
34
                           (incf x) (incf y 2))
35 36 37 38 39 40 41 42
     x y))
  (0 0 1 2))

(deftest multiple-value-prog1.7
  (let ((x 0) (y 0))
    (multiple-value-call
     #'list
     (multiple-value-prog1 (values (incf x) y)
sds's avatar
sds committed
43 44
                           (incf x x)
                           (incf y 10))
45 46 47
     x y))
  (1 0 2 10))

48

49 50
(deftest multiple-value-prog1.8
  (let* ((n (min 100 multiple-values-limit)))
51
    (not-mv
52
     (loop for i from 0 below n
sds's avatar
sds committed
53 54 55 56 57 58 59
           for x = (make-int-list i)
           always
           (equalt
            (multiple-value-list
             (eval `(multiple-value-prog1 (values-list (quote ,(copy-seq x)))
                                          nil)))
            x))))
60
  nil)
61

62 63 64 65 66 67

(deftest multiple-value-prog1.9
  (let ((x 0) (y 0))
    (values
     (block foo
       (multiple-value-prog1
sds's avatar
sds committed
68 69
        (values (incf x) (incf y 2))
        (return-from foo 'a)))
70 71
     x y))
  a 1 2)
72 73 74 75 76 77 78 79 80 81 82 83 84 85

;;; No implicit tagbody
(deftest multiple-value-prog1.10
  (block nil
    (tagbody
     (multiple-value-prog1
      (values)
      (go 10)
      10
      (return 'bad))
     10
     (return 'good)))
  good)

86 87 88 89 90 91 92 93 94 95 96 97 98
;;; Macros are expanded in the appropriate environment

(deftest multiple-value-prog1.11
  (macrolet
   ((%m (z) z))
   (multiple-value-prog1 (expand-in-current-env (%m :good))))
  :good)

(deftest multiple-value-prog1.12
  (macrolet
   ((%m (z) z))
   (multiple-value-prog1 :good (expand-in-current-env (%m :foo))))
  :good)