X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fsetf.impure.lisp;h=b15917360f9042f151268735288b06e0d2cae296;hb=2fb5b174f6acb88a85c86aa4cd753ddefaccc987;hp=77c4ac5257dc196701430ab85acad6c7a1d61e9c;hpb=ba176faab453c2b5d4d9a6667a84680c8783c957;p=sbcl.git diff --git a/tests/setf.impure.lisp b/tests/setf.impure.lisp index 77c4ac5..b159173 100644 --- a/tests/setf.impure.lisp +++ b/tests/setf.impure.lisp @@ -23,5 +23,32 @@ ;;; environment object. (assert (multiple-value-list (get-setf-expansion '(foo)))) +;;; Regression test for SHIFTF of values. +(let ((x (list 1)) + (y (list 2))) + (shiftf (values (car x) (car y)) (values (car y) (car x))) + (assert (equal (list x y) '((2) (1))))) + +;;; SETF of values with multiple-value place forms +(let ((a t) (b t) (c t) (d t)) + (let ((list (multiple-value-list + (setf (values (values a b) (values c d)) (values 1 2 3 4))))) + (assert (equal list '(1 2))) + (assert (eql a 1)) + (assert (eql c 2)) + (assert (null b)) + (assert (null d)))) + +;;; SETF of THE with VALUES. +(let (x y) + (setf (the (values fixnum fixnum) (values x y)) + (values 1 2)) + (assert (= x 1)) + (assert (= y 2))) + +;;; SETF of MACRO-FUNCTION must accept a NIL environment +(let ((fun (constantly 'ok))) + (setf (macro-function 'nothing-at-all nil) fun) + (assert (eq fun (macro-function 'nothing-at-all nil)))) + ;;; success -(quit :unix-status 104) \ No newline at end of file