diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 4c1c2495345b6fec75d1a0f124cb0a96c0f20571..5c44627b24a13aa8c7f1daf9eaed6b1c5843b8da 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -7,6 +7,7 @@ (load "constantly.lsp") (load "complement.lsp") +(load "setf-apply.lsp") ;;; Tests of conses diff --git a/ansi-tests/setf-apply.lsp b/ansi-tests/setf-apply.lsp new file mode 100644 index 0000000000000000000000000000000000000000..33e8dbf0de6d037243704de34e37212733639780 --- /dev/null +++ b/ansi-tests/setf-apply.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Oct 6 22:11:00 2002 +;;;; Contains: Tests of (SETF (APPLY ...) ...) forms + +(in-package :cl-test) + +;;; +;;; According to section 5.1.2.5 of the CL Spec, +;;; there are three kinds of (APPLY ...) forms that +;;; may appear in the first argument of a SETF form. +;;; + +(deftest setf-apply.1 + (let ((x (vector 0 1 2 3 4 5))) + (setf (apply #'aref x '(0)) 10) + x) + #(10 1 2 3 4 5)) + +(deftest setf-apply.2 + (let ((a (make-array '(2 2) :initial-contents '((0 0)(0 0))))) + (setf (apply #'aref a 1 1 nil) 'a) + (equalp a (make-array '(2 2) :initial-contents '((0 0)(0 a))))) + t) + +(deftest setf-apply.3 + (let ((bv (copy-seq #*0000000000))) + (setf (apply #'bit bv 4 nil) 1) + bv) + #*0000100000) + +(deftest setf-apply.4 + (let ((bv (copy-seq #*0000000000))) + (setf (apply #'sbit bv 4 nil) 1) + bv) + #*0000100000) + + +