nth-value.lsp 1.62 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 19 08:24:14 2002
;;;; Contains: Tests of NTH-VALUE

(in-package :cl-test)

(deftest nth-value.1
  (nth-value 0 'a)
  a)

(deftest nth-value.2
  (nth-value 1 'a)
  nil)

(deftest nth-value.3
  (nth-value 0 (values))
  nil)

(deftest nth-value.4
  (loop for i from 0 to 19
sds's avatar
sds committed
22 23
        collect (nth-value i (values 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k
                                     'l 'm 'n 'o 'p 'q 'r 's)))
pfdietz's avatar
pfdietz committed
24 25 26 27 28 29
  (a b c d e f g h i j k l m n o p q r s nil))

(deftest nth-value.5
  (nth-value 100 'a)
  nil)

30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest nth-value.6
  (macrolet
   ((%m (z) z))
   (nth-value (expand-in-current-env (%m 1)) (values 'a 'b 'c)))
  b)

(deftest nth-value.7
  (macrolet
   ((%m (z) z))
   (nth-value 1 (expand-in-current-env (%m (values 'a 'b 'c)))))
  b)

;;; Order of evaluation test

47 48 49 50
(deftest nth-value.order.1
  (let ((i 0) x y)
    (values
     (nth-value (progn (setf x (incf i)) 3)
sds's avatar
sds committed
51
                (progn (setf y (incf i)) (values 'a 'b 'c 'd 'e 'f 'g)))
52 53
     i x y))
  d 2 1 2)
54

55 56
;;; Error tests

57
(deftest nth-value.error.1
58
  (signals-error (funcall (macro-function 'nth-value))
sds's avatar
sds committed
59
                 program-error)
60
  t)
sds's avatar
sds committed
61

62
(deftest nth-value.error.2
63
  (signals-error (funcall (macro-function 'nth-value)
sds's avatar
sds committed
64 65
                           '(nth-value 1 '(a b c)))
                 program-error)
66
  t)
67 68

(deftest nth-value.error.3
69
  (signals-error (funcall (macro-function 'nth-value)
sds's avatar
sds committed
70 71 72
                           '(nth-value 1 '(a b c))
                           nil nil)
                 program-error)
73
  t)