From eb84012eb84c87cddb477bfd93d115f4409bf73a Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 7 Oct 2002 03:18:58 +0000 Subject: [PATCH] Added setf-apply.lsp, which tests some forms like (SETF (APPLY ...) ...). --- ansi-tests/gclload2.lsp | 1 + ansi-tests/setf-apply.lsp | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+) create mode 100644 ansi-tests/setf-apply.lsp diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 4c1c2495..5c44627b 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 00000000..33e8dbf0 --- /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) + + + -- GitLab