From 30e82c01625f063502a3019d0ecd4ef57fb8d5d2 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Fri, 24 Jan 2003 04:22:54 +0000 Subject: [PATCH] Many cleanups. Replaced notnot, not with notnot-mv, not-mv in places where we can inspect the results for the right number of multiple values. Ditto for multiple-value-bind*, which is strict in checking for number of values. Indentation changes. --- ansi-tests/ansi-aux.lsp | 27 +++- ansi-tests/array-aux.lsp | 23 ++-- ansi-tests/compiled-function-p.lsp | 6 +- ansi-tests/complement.lsp | 12 +- ansi-tests/cons-test-01.lsp | 39 +++--- ansi-tests/cons-test-03.lsp | 40 +++--- ansi-tests/cons-test-06.lsp | 6 +- ansi-tests/cons-test-11.lsp | 6 +- ansi-tests/cons-test-14.lsp | 21 ++-- ansi-tests/cons-test-20.lsp | 14 +-- ansi-tests/cons-test-21.lsp | 12 +- ansi-tests/cons-test-23.lsp | 184 ++++++++++++++-------------- ansi-tests/cons-test-24.lsp | 16 +-- ansi-tests/constantly.lsp | 6 +- ansi-tests/constantp.lsp | 14 +-- ansi-tests/copy-seq.lsp | 28 ++--- ansi-tests/defconstant.lsp | 4 +- ansi-tests/elt.lsp | 85 ++++++++----- ansi-tests/eql.lsp | 2 +- ansi-tests/every.lsp | 53 ++++---- ansi-tests/fboundp.lsp | 10 +- ansi-tests/fmakunbound.lsp | 8 +- ansi-tests/function.lsp | 14 +-- ansi-tests/functionp.lsp | 12 +- ansi-tests/identity.lsp | 6 +- ansi-tests/lambda-list-keywords.lsp | 15 +-- ansi-tests/length.lsp | Bin 2382 -> 2380 bytes ansi-tests/map-into.lsp | 2 +- ansi-tests/merge.lsp | 2 +- ansi-tests/multiple-value-prog1.lsp | 2 +- ansi-tests/nil.lsp | 2 +- ansi-tests/notany.lsp | 20 +-- ansi-tests/notevery.lsp | 8 +- ansi-tests/packages-03.lsp | 8 +- ansi-tests/packages-04.lsp | 8 +- ansi-tests/packages-05.lsp | 4 +- ansi-tests/packages-07.lsp | 24 ++-- ansi-tests/packages-11.lsp | 22 ++-- ansi-tests/packages-12.lsp | 24 ++-- ansi-tests/packages-16.lsp | 28 ++--- ansi-tests/packages-18.lsp | 2 +- ansi-tests/simple-vector-p.lsp | 4 +- ansi-tests/some.lsp | 8 +- ansi-tests/structure-00.lsp | 10 +- ansi-tests/structures-01.lsp | 56 ++++----- ansi-tests/t.lsp | 2 +- 46 files changed, 469 insertions(+), 430 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index c42bb9c8..488ea731 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -13,13 +13,32 @@ (defun notnot (x) (not (not x))) (defmacro notnot-mv (form) - `(apply #'values (mapcar #'notnot (multiple-value-list ,form)))) + `(notnot-mv-fn (multiple-value-list ,form))) -;;; Macro to check that a function is returning a single value -(defmacro check-value (form &optional (num 1)) +(defun notnot-mv-fn (results) + (if (null results) + (values) + (apply #'values + (not (not (first results))) + (rest results)))) + +(defmacro not-mv (form) + `(not-mv-fn (multiple-value-list ,form))) + +(defun not-mv-fn (results) + (if (null results) + (values) + (apply #'values + (not (first results)) + (rest results)))) + + +;;; Macro to check that a function is returning a specified number of values +;;; (defaults to 1) +(defmacro check-values (form &optional (num 1)) (let ((v (gensym)) (n (gensym))) - `(let ((,v ,form) + `(let ((,v (multiple-value-list ,form)) (,n ,num)) (check-values-length ,v ,n ',form) (car ,v)))) diff --git a/ansi-tests/array-aux.lsp b/ansi-tests/array-aux.lsp index 0f10527a..999c2f75 100644 --- a/ansi-tests/array-aux.lsp +++ b/ansi-tests/array-aux.lsp @@ -9,7 +9,7 @@ (subtypep* type (array-element-type (make-array 0 :element-type type)))) (defun subtypep-or-unknown (subtype supertype) - (multiple-value-bind (is-subtype is-known) + (multiple-value-bind* (is-subtype is-known) (subtypep subtype supertype) (or (not is-known) (notnot is-subtype)))) @@ -30,10 +30,10 @@ "Call MAKE-ARRAY and do sanity tests on the output." (declare (ignore element-type-p initial-contents initial-contents-p initial-element initial-element-p dio-p)) - (let ((a (apply #'make-array dimensions options))) + (let ((a (check-values (apply #'make-array dimensions options)))) (cond ((not (typep a 'array)) :fail-not-array) - ((not (arrayp a)) :fail-not-arrayp) + ((not (check-values (arrayp a))) :fail-not-arrayp) ((and (eq t element-type) (not adjustable) @@ -92,18 +92,18 @@ ;; If :adjustable is given, the array must be adjustable. ((and adjustable - (not (adjustable-array-p a)) + (not (check-values (adjustable-array-p a))) :fail-adjustable)) ;; If :fill-pointer is given, the array must have a fill pointer ((and fill-pointer - (not (array-has-fill-pointer-p a)) + (not (check-values (array-has-fill-pointer-p a))) :fail-has-fill-pointer)) ;; If the fill pointer is given as an integer, it must be the value ;; of the fill pointer of the new array - ((and (integerp fill-pointer) - (not (eql fill-pointer (fill-pointer a))) + ((and (check-values (integerp fill-pointer)) + (not (eql fill-pointer (check-values (fill-pointer a)))) :fail-fill-pointer-1)) ;; If the fill-pointer argument is t, the fill pointer must be @@ -115,7 +115,7 @@ ;; If displaced-to another array, check that this is proper ((and displaced-to - (multiple-value-bind (actual-dt actual-dio) + (multiple-value-bind* (actual-dt actual-dio) (array-displacement a) (cond ((not (eq actual-dt displaced-to)) @@ -124,14 +124,15 @@ :fail-displaced-index-offset))))) ;; Test of array-total-size - ((not (eql (array-total-size a) + ((not (eql (check-values (array-total-size a)) (reduce #'* dimensions-list :initial-value 1))) :fail-array-total-size) ;; Test array-row-major-index on all zeros ((and (> (array-total-size a) 0) - (not (eql (apply #'array-row-major-index - a (make-list (array-rank a) :initial-element 0)) + (not (eql (check-values + (apply #'array-row-major-index + a (make-list (array-rank a) :initial-element 0))) 0))) :fail-array-row-major-index-0) diff --git a/ansi-tests/compiled-function-p.lsp b/ansi-tests/compiled-function-p.lsp index e2caffa8..95bf9e9d 100644 --- a/ansi-tests/compiled-function-p.lsp +++ b/ansi-tests/compiled-function-p.lsp @@ -7,7 +7,7 @@ (deftest compiled-function-p.1 (some #'(lambda (obj) - (if (compiled-function-p obj) + (if (check-values (compiled-function-p obj)) (not (typep obj 'compiled-function)) (typep obj 'compiled-function))) *universe*) @@ -18,8 +18,8 @@ nil) (deftest compiled-function-p.3 - (not (compiled-function-p (compile nil '(lambda (y x) (cons x y))))) - nil) + (notnot-mv (compiled-function-p (compile nil '(lambda (y x) (cons x y))))) + t) (deftest compiled-function-p.error.1 (classify-error (compiled-function-p)) diff --git a/ansi-tests/complement.lsp b/ansi-tests/complement.lsp index 87459c2c..5194fff8 100644 --- a/ansi-tests/complement.lsp +++ b/ansi-tests/complement.lsp @@ -6,8 +6,8 @@ (in-package :cl-test) (deftest complement.1 - (not (funcall (complement #'identity) nil)) - nil) + (notnot-mv (funcall (complement #'identity) nil)) + t) (deftest complement.2 (funcall (complement #'identity) t) @@ -28,11 +28,13 @@ t) (deftest complement.5 + (notnot-mv (complement #'identity)) + t) + +(deftest complement.error.1 (classify-error (complement)) program-error) -(deftest complement.6 +(deftest complement.error.2 (classify-error (complement #'not t)) program-error) - - diff --git a/ansi-tests/cons-test-01.lsp b/ansi-tests/cons-test-01.lsp index bbbc64d7..151099a3 100644 --- a/ansi-tests/cons-test-01.lsp +++ b/ansi-tests/cons-test-01.lsp @@ -116,68 +116,67 @@ ;; All the cons-related macros have a macro binding (deftest macro-bound-cons-macros - (not (every #'macro-function - (list 'push 'pop 'pushnew 'remf))) - nil) + (notnot-mv (every #'macro-function + (list 'push 'pop 'pushnew 'remf))) + t) ;; None of the cons-related functions have macro bindings (deftest no-cons-fns-are-macros - (some #'macro-function *cons-fns*) + (some #'macro-function *cons-fns*) nil) ;; Various easy tests of cons (deftest cons-of-symbols - (cons 'a 'b) + (cons 'a 'b) (a . b)) (deftest cons-with-nil - (cons 'a nil) + (cons 'a nil) (a)) ;; successive calls to cons produces results that are equal, but not eq (deftest cons-eq-equal - (let ((x (cons 'a 'b)) - (y (cons 'a 'b))) - (and (not (eqt x y)) - (equal x y) - t)) + (let ((x (cons 'a 'b)) + (y (cons 'a 'b))) + (and (not (eqt x y)) + (equalt x y))) t) ;; list can be expressed as a bunch of conses (with nil) (deftest cons-equal-list - (equal (cons 'a (cons 'b (cons 'c nil))) - (list 'a 'b 'c)) + (equalt (cons 'a (cons 'b (cons 'c nil))) + (list 'a 'b 'c)) t) ;; Lists satisfy consp (deftest consp-list - (not (not (consp '(a)))) + (notnot-mv (consp '(a))) t) ;; cons satisfies consp (deftest consp-cons - (not (not (consp (cons nil nil)))) + (notnot-mv (consp (cons nil nil))) t) ;; nil is not a consp (deftest consp-nil - (consp nil) + (consp nil) nil) ;; The empty list is not a cons (deftest consp-empty-list - (consp (list)) + (consp (list)) nil) ;; A single element list is a cons (deftest consp-single-element-list - (not (not (consp (list 'a)))) + (notnot-mv (consp (list 'a))) t) ;; For everything in *universe*, it is either an atom, or satisfies ;; consp, but not both (deftest consp-xor-atom-universe - (notnot + (notnot-mv (every #'(lambda (x) (or (and (consp x) (not (atom x))) (and (not (consp x)) (atom x)))) *universe*)) @@ -185,7 +184,7 @@ ;; Everything in type cons satisfies consp, and vice versa (deftest consp-cons-universe - (check-type-predicate 'consp 'cons) + (check-type-predicate 'consp 'cons) 0) (deftest consp.error.1 diff --git a/ansi-tests/cons-test-03.lsp b/ansi-tests/cons-test-03.lsp index 751eac89..3d7ba610 100644 --- a/ansi-tests/cons-test-03.lsp +++ b/ansi-tests/cons-test-03.lsp @@ -107,31 +107,31 @@ ;; Check listp against various simple cases (deftest listp-nil - (not (not (listp nil))) + (notnot-mv (listp nil)) t) (deftest listp-symbol - (listp 'a) + (listp 'a) nil) (deftest listp-singleton-list - (not (not (listp '(a)))) + (notnot-mv (listp '(a))) t) (deftest listp-circular-list - (let ((x (cons nil nil))) - (setf (cdr x) x) - (not (not (listp x)))) + (let ((x (cons nil nil))) + (setf (cdr x) x) + (notnot-mv (listp x))) t) (deftest listp-longer-list - (not (not (listp '(a b c d e f g h)))) + (notnot-mv (listp '(a b c d e f g h))) t) ;;; Check that (listp x) == (typep x 'list) (deftest listp-universe - (check-type-predicate 'listp 'list) + (check-type-predicate 'listp 'list) 0) (deftest listp.error.1 @@ -148,25 +148,25 @@ ;;; These tests are now somewhat redundant (deftest typep-nil-list - (not (not (typep nil 'list))) + (notnot-mv (typep nil 'list)) t) (deftest typep-symbol-list - (typep 'a 'list) + (typep 'a 'list) nil) (deftest typep-singleton-list-list - (not (not (typep '(a) 'list))) + (notnot-mv (typep '(a) 'list)) t) (deftest typep-circular-list-list - (let ((x (cons nil nil))) - (setf (cdr x) x) - (not (not (typep x 'list)))) + (let ((x (cons nil nil))) + (setf (cdr x) x) + (notnot-mv (typep x 'list))) t) (deftest typep-longer-list-list - (not (not (typep '(a b c d e f g h) 'list))) + (notnot-mv (typep '(a b c d e f g h) 'list)) t) @@ -174,19 +174,19 @@ ;;; make-list (deftest make-list-empty-1 - (make-list 0) + (make-list 0) nil) (deftest make-list-empty-2 - (make-list 0 :initial-element 'a) + (make-list 0 :initial-element 'a) nil) (deftest make-list-no-initial-element - (make-list 6) + (make-list 6) (nil nil nil nil nil nil)) (deftest make-list-with-initial-element - (make-list 6 :initial-element 'a) + (make-list 6 :initial-element 'a) (a a a a a a)) (deftest make-list.allow-other-keys.1 @@ -220,7 +220,7 @@ ;; This next test causes ACL 4.3 (Linux) to loop #-allegro (deftest make-list-type.error.2 - (catch-type-error (make-list 'a)) + (classify-error (make-list 'a)) type-error) (deftest make-list.error.3 diff --git a/ansi-tests/cons-test-06.lsp b/ansi-tests/cons-test-06.lsp index 3f3b365e..6c83a12f 100644 --- a/ansi-tests/cons-test-06.lsp +++ b/ansi-tests/cons-test-06.lsp @@ -12,15 +12,15 @@ ;;; endp (deftest endp-nil - (not (not (endp nil))) + (notnot-mv (endp nil)) t) (deftest endp-cons - (endp (cons 'a 'a)) + (endp (cons 'a 'a)) nil) (deftest endp-singleton-list - (endp '(a)) + (endp '(a)) nil) (deftest endp-symbol-error diff --git a/ansi-tests/cons-test-11.lsp b/ansi-tests/cons-test-11.lsp index dcfd1d22..b9d6751a 100644 --- a/ansi-tests/cons-test-11.lsp +++ b/ansi-tests/cons-test-11.lsp @@ -178,7 +178,7 @@ ;; TAILP-NIL:T in the X3J13 documentation. (deftest tailp.error.1 - (catch-type-error (not (not (tailp 'e (copy-tree '(a b c d . e)))))) + (catch-type-error (notnot-mv (tailp 'e (copy-tree '(a b c d . e))))) t) (deftest tailp.error.2 @@ -186,8 +186,8 @@ nil) (deftest tailp.error.3 - (catch-type-error (not (not (tailp 10203040506070 - (list* 'a 'b (1- 10203040506071)))))) + (catch-type-error (notnot-mv (tailp 10203040506070 + (list* 'a 'b (1- 10203040506071))))) t) (deftest tailp.error.4 diff --git a/ansi-tests/cons-test-14.lsp b/ansi-tests/cons-test-14.lsp index 8d57a364..31b5a987 100644 --- a/ansi-tests/cons-test-14.lsp +++ b/ansi-tests/cons-test-14.lsp @@ -29,15 +29,16 @@ (a b c . d) ,(make-array '(10)) "ancadas" #\w))) - (not (every - #'(lambda (x) - (let ((result (catch-type-error (member-if #'listp x)))) - (or (eqt result 'type-error) - (progn - (format t "~%On ~S: returned ~%~S" x result) - nil)))) - test-inputs))) - nil) + (notnot-mv + (every + #'(lambda (x) + (let ((result (catch-type-error (member-if #'listp x)))) + (or (eqt result 'type-error) + (progn + (format t "~%On ~S: returned ~%~S" x result) + nil)))) + test-inputs))) + t) (deftest member-if-5 (member-if #'identity '(1 2 3 4 5) :key #'evenp) @@ -196,5 +197,3 @@ (deftest member-if-not.error.7 (classify-error (member-if-not #'null '(a b c) 1 2)) program-error) - - diff --git a/ansi-tests/cons-test-20.lsp b/ansi-tests/cons-test-20.lsp index bb2e8eb0..d0865761 100644 --- a/ansi-tests/cons-test-20.lsp +++ b/ansi-tests/cons-test-20.lsp @@ -197,13 +197,13 @@ do (progn (setf x (* x x)) (setf y (* y y)))) - (not (not - (or - (eqt x y) ;; if bignums are eq, the test is worthless - (eql (length - (union-with-check - (list x) (list x))) - 1))))) + (notnot-mv + (or + (eqt x y) ;; if bignums are eq, the test is worthless + (eql (length + (union-with-check + (list x) (list x))) + 1)))) t) (deftest union-27 diff --git a/ansi-tests/cons-test-21.lsp b/ansi-tests/cons-test-21.lsp index c2e994e7..21e71177 100644 --- a/ansi-tests/cons-test-21.lsp +++ b/ansi-tests/cons-test-21.lsp @@ -195,12 +195,12 @@ do (progn (setf x (* x x)) (setf y (* y y)))) - (not (not - (or - (eqt x y) ;; if bignums are eq, the test is worthless - (eql (length - (nunion-with-copy (list x) (list x))) - 1))))) + (notnot-mv + (or + (eqt x y) ;; if bignums are eq, the test is worthless + (eql (length + (nunion-with-copy (list x) (list x))) + 1)))) t) (deftest nunion-27 diff --git a/ansi-tests/cons-test-23.lsp b/ansi-tests/cons-test-23.lsp index cec89549..d994b64a 100644 --- a/ansi-tests/cons-test-23.lsp +++ b/ansi-tests/cons-test-23.lsp @@ -114,61 +114,61 @@ ;; the order of the arguments to the test function ;; (deftest set-exclusive-or-17 - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (set-exclusive-or-with-check - list1 list2 - :test #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)))))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) t) (deftest set-exclusive-or-17-a - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (set-exclusive-or-with-check - list1 list2 - :key #'identity - :test #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)))))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :key #'identity + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) t) (deftest set-exclusive-or-18 - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (set-exclusive-or-with-check - list1 list2 - :test-not - #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)) - t)))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) t) (deftest set-exclusive-or-18-a - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (set-exclusive-or-with-check - list1 list2 - :key #'identity - :test-not - #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)) - t)))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (set-exclusive-or-with-check + list1 list2 + :key #'identity + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) t) ;;; Keyword tests @@ -365,61 +365,61 @@ ;; the order of the arguments to the test function ;; (deftest nset-exclusive-or-17 - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (nset-exclusive-or-with-check - list1 list2 - :test #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)))))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) t) (deftest nset-exclusive-or-17-a - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (nset-exclusive-or-with-check - list1 list2 - :key #'identity - :test #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)))))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :key #'identity + :test #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed))))))) t) (deftest nset-exclusive-or-18 - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (nset-exclusive-or-with-check - list1 list2 - :test-not - #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)) - t)))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) t) (deftest nset-exclusive-or-18-a - (let ((list1 '(a b c d)) - (list2 '(e f g h))) - (block fail - (not (not - (nset-exclusive-or-with-check - list1 list2 - :key #'identity - :test-not - #'(lambda (s1 s2) - (when (or (member s1 list2) - (member s2 list1)) - (return-from fail 'failed)) - t)))))) + (let ((list1 '(a b c d)) + (list2 '(e f g h))) + (block fail + (notnot-mv + (nset-exclusive-or-with-check + list1 list2 + :key #'identity + :test-not + #'(lambda (s1 s2) + (when (or (member s1 list2) + (member s2 list1)) + (return-from fail 'failed)) + t))))) t) ;;; Keyword tests diff --git a/ansi-tests/cons-test-24.lsp b/ansi-tests/cons-test-24.lsp index c429f081..167c12bc 100644 --- a/ansi-tests/cons-test-24.lsp +++ b/ansi-tests/cons-test-24.lsp @@ -129,43 +129,43 @@ ;;; Keyword tests (deftest subsetp.allow-other-keys.1 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :bad t :allow-other-keys 67)) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :bad t :allow-other-keys 67)) t) (deftest subsetp.allow-other-keys.2 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys #'cons :bad t)) t) (deftest subsetp.allow-other-keys.3 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4) :allow-other-keys (make-hash-table) :bad t :test #'(lambda (x y) (= (1+ x) y)))) nil) (deftest subsetp.allow-other-keys.4 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys t)) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys t)) t) (deftest subsetp.allow-other-keys.5 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys nil)) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys nil)) t) (deftest subsetp.allow-other-keys.6 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys t :bad1 t :allow-other-keys nil :bad2 t)) t) (deftest subsetp.keywords.7 - (notnot (subsetp '(1 2 3 4) '(0 1 2 3 4) + (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4) :test #'(lambda (x y) (= (1+ x) y)) :test #'eql)) nil) (deftest subsetp.keywords.8 - (notnot (subsetp '(1 2 3 4 10) '(0 1 2 3 4) + (notnot-mv (subsetp '(1 2 3 4 10) '(0 1 2 3 4) :key nil :key #'(lambda (x) (mod x 2)))) nil) diff --git a/ansi-tests/constantly.lsp b/ansi-tests/constantly.lsp index 119d1bd9..a68a295c 100644 --- a/ansi-tests/constantly.lsp +++ b/ansi-tests/constantly.lsp @@ -14,9 +14,13 @@ t) (deftest constantly.2 + (notnot-mv (cl:constantly 1)) + t) + +(deftest constantly.error.1 (classify-error (cl:constantly)) program-error) -(deftest constantly.3 +(deftest constantly.error.2 (classify-error (cl:constantly 1 1)) program-error) diff --git a/ansi-tests/constantp.lsp b/ansi-tests/constantp.lsp index 77405b09..32cad912 100644 --- a/ansi-tests/constantp.lsp +++ b/ansi-tests/constantp.lsp @@ -25,15 +25,15 @@ nil) (deftest constantp.2 - (notnot (constantp t)) + (notnot-mv (constantp t)) t) (deftest constantp.3 - (notnot (constantp nil)) + (notnot-mv (constantp nil)) t) (deftest constantp.4 - (notnot (constantp :foo)) + (notnot-mv (constantp :foo)) t) (deftest constantp.5 @@ -43,7 +43,7 @@ (defconstant constantp-test-symbol 1) (defmacro constantp-macro (form &environment env) - (notnot (constantp form env))) + (notnot-mv (constantp form env))) (deftest constantp.6 (constantp-macro constantp-test-symbol) @@ -54,15 +54,15 @@ nil) (deftest constantp.8 - (notnot (constantp 1 nil)) + (notnot-mv (constantp 1 nil)) t) (deftest constantp.9 - (notnot (constantp ''(((foo))))) + (notnot-mv (constantp ''(((foo))))) t) (deftest constantp.10 - (notnot (constantp 'pi)) + (notnot-mv (constantp 'pi)) t) diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index 2912bbe9..6c2d4fd9 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -14,21 +14,21 @@ (deftest copy-seq.2 (let* ((s1 '(a b c)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (equalt s1 s2))) t) (deftest copy-seq.3 (let* ((s1 #(a b c)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) s2)) #(a b c)) (deftest copy-seq.4 (let* ((s1 (make-array '(4) :initial-contents '(a b c d) :adjustable t)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-vector-p s2) s2)) @@ -38,7 +38,7 @@ (deftest copy-seq.5 (let* ((s1 (make-array '(4) :initial-contents '(a b c d) :fill-pointer 3)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-vector-p s2) s2)) @@ -48,7 +48,7 @@ (let* ((a1 (make-array '(6) :initial-contents '(a b c d e f))) (a2 (make-array '(4) :displaced-to a1 :displaced-index-offset 1)) - (s2 (copy-seq a2))) + (s2 (check-values (copy-seq a2)))) (and (not (eql a2 s2)) (simple-vector-p s2) s2)) @@ -59,7 +59,7 @@ :element-type 'base-char :initial-contents '(#\a #\b #\c #\d) :adjustable t)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-string-p s2) s2)) @@ -71,7 +71,7 @@ :element-type 'base-char :initial-contents '(#\a #\b #\c #\d) :fill-pointer 3)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-string-p s2) s2)) @@ -83,7 +83,7 @@ (a2 (make-array '(4) :displaced-to a1 :element-type 'base-char :displaced-index-offset 1)) - (s2 (copy-seq a2))) + (s2 (check-values (copy-seq a2)))) (and (not (eql a2 s2)) (simple-string-p s2) s2)) @@ -91,14 +91,14 @@ (deftest copy-seq.10 (let*((s1 "abcd") - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) s2)) "abcd") (deftest copy-seq.11 (let* ((s1 #*0010110) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-bit-vector-p s2) s2)) @@ -108,7 +108,7 @@ (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0) :element-type 'bit :adjustable t)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-bit-vector-p s2) s2)) @@ -118,7 +118,7 @@ (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0) :element-type 'bit :fill-pointer 3)) - (s2 (copy-seq s1))) + (s2 (check-values (copy-seq s1)))) (and (not (eql s1 s2)) (simple-bit-vector-p s2) s2)) @@ -130,7 +130,7 @@ (a2 (make-array '(4) :displaced-to a1 :displaced-index-offset 1 :element-type 'bit)) - (s2 (copy-seq a2))) + (s2 (check-values (copy-seq a2)))) (and (not (eql a2 s2)) (simple-bit-vector-p s2) s2)) @@ -150,7 +150,7 @@ (deftest copy-seq.18 (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j))) - (y (copy-seq x))) + (y (check-values (copy-seq x)))) (equal-array x y)) t) diff --git a/ansi-tests/defconstant.lsp b/ansi-tests/defconstant.lsp index 5b9cc3f7..02a69e95 100644 --- a/ansi-tests/defconstant.lsp +++ b/ansi-tests/defconstant.lsp @@ -12,8 +12,8 @@ 17) (deftest defconstant.2 - (not (constantp 'test-constant-1)) - nil) + (notnot-mv (constantp 'test-constant-1)) + t) (deftest defconstant.3 (documentation 'test-constant-1 'variable) diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp index 21a842fb..9a76c8df 100644 --- a/ansi-tests/elt.lsp +++ b/ansi-tests/elt.lsp @@ -9,19 +9,30 @@ ;; elt on lists -(deftest elt-1 (safe-elt nil 0) type-error) -(deftest elt-1a (safe-elt nil -10) type-error) -(deftest elt-2 (safe-elt nil 1000000) type-error) -(deftest elt-3 (safe-elt '(a b c d e) 0) a) -(deftest elt-4 (safe-elt '(a b c d e) 2) c) -(deftest elt-5 (safe-elt '(a b c d e) 4) e) -(deftest elt-5a (safe-elt '(a b c d e) -4) type-error) +(deftest elt-1 + (classify-error (elt nil 0)) + type-error) + +(deftest elt-1a + (classify-error (elt nil -10)) + type-error) + +(deftest elt-2 + (classify-error (elt nil 1000000)) + type-error) + +(deftest elt-3 (elt '(a b c d e) 0) a) +(deftest elt-4 (elt '(a b c d e) 2) c) +(deftest elt-5 (elt '(a b c d e) 4) e) +(deftest elt-5a + (classify-error (elt '(a b c d e) -4)) + type-error) + (deftest elt-6 (let ((x (make-int-list 1000))) - (notnot + (notnot-mv (every - #'(lambda (i) - (eql i (safe-elt x i))) + #'(lambda (i) (eql i (elt x i))) x))) t) @@ -53,7 +64,7 @@ (let ((x (list 'a 'b 'c 'd 'e))) (let ((y (loop for c on x collect c))) (setf (elt x 2) 'f) - (notnot + (notnot-mv (every #'eq y (loop for c on x collect c))))) @@ -61,48 +72,51 @@ (deftest elt-12 (let ((x (make-int-list 100000))) - (safe-elt x 90000)) + (elt x 90000)) 90000) (deftest elt-13 (let ((x (make-int-list 100000))) (setf (elt x 80000) 'foo) - (list (safe-elt x 79999) - (safe-elt x 80000) - (safe-elt x 80001))) + (list (elt x 79999) + (elt x 80000) + (elt x 80001))) (79999 foo 80001)) - -;; Special case to test error handling as dictated by new -;; CL standard (deftest elt-14 - (let ((x (list 'a 'b 'c))) - (safe-elt x 10)) + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x 10))) type-error) (deftest elt-15 - (let ((x (list 'a 'b 'c))) - (safe-elt x 'a)) + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x 'a))) type-error) (deftest elt-16 - (let ((x (list 'a 'b 'c))) - (safe-elt x 10.0)) + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x 10.0))) type-error) (deftest elt-17 - (let ((x (list 'a 'b 'c))) - (safe-elt x -1)) + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x -1))) type-error) (deftest elt-18 - (let ((x (list 'a 'b 'c))) - (safe-elt x -100000000000000000)) + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x -100000000000000000))) type-error) (deftest elt-19 - (let ((x (list 'a 'b 'c))) - (safe-elt x #\w)) + (classify-error + (let ((x (list 'a 'b 'c))) + (elt x #\w))) type-error) (deftest elt-v-1 @@ -111,11 +125,16 @@ type-error) ;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined -(deftest elt-v-3 (elt (make-array '(5) :initial-contents '(a b c d e)) 0) +(deftest elt-v-3 + (elt (make-array '(5) :initial-contents '(a b c d e)) 0) a) -(deftest elt-v-4 (elt (make-array '(5) :initial-contents '(a b c d e)) 2) + +(deftest elt-v-4 + (elt (make-array '(5) :initial-contents '(a b c d e)) 2) c) -(deftest elt-v-5 (elt (make-array '(5) :initial-contents '(a b c d e)) 4) + +(deftest elt-v-5 + (elt (make-array '(5) :initial-contents '(a b c d e)) 4) e) (deftest elt-v-6 diff --git a/ansi-tests/eql.lsp b/ansi-tests/eql.lsp index 7dac296c..1de4c061 100644 --- a/ansi-tests/eql.lsp +++ b/ansi-tests/eql.lsp @@ -10,7 +10,7 @@ ;;; is true. (deftest eql.1 - (loop for x in *universe* always (eql x x)) + (loop for x in *universe* always (check-values (eql x x))) t) (deftest eql.2 diff --git a/ansi-tests/every.lsp b/ansi-tests/every.lsp index 7b266acb..7f1f3bb5 100644 --- a/ansi-tests/every.lsp +++ b/ansi-tests/every.lsp @@ -6,12 +6,12 @@ (in-package :cl-test) (deftest every.1 - (not (every #'identity nil)) - nil) + (notnot-mv (every #'identity nil)) + t) (deftest every.2 - (not (every #'identity #())) - nil) + (notnot-mv (every #'identity #())) + t) (deftest every.3 (let ((count 0)) @@ -22,50 +22,49 @@ nil 4) (deftest every.4 - (not (every #'= '(1 2 3 4) '(1 2 3 4 5))) - nil) + (notnot-mv (every #'= '(1 2 3 4) '(1 2 3 4 5))) + t) (deftest every.5 - (not (every #'= '(1 2 3 4 5) '(1 2 3 4))) - nil) + (notnot-mv (every #'= '(1 2 3 4 5) '(1 2 3 4))) + t) (deftest every.6 (every #'= '(1 2 3 4 5) '(1 2 3 4 6)) nil) (deftest every.7 - (not (every #'(lambda (x y) (or x y)) - '(nil t t nil t) #(t nil t t nil nil))) - nil) + (notnot-mv (every #'(lambda (x y) (or x y)) + '(nil t t nil t) #(t nil t t nil nil))) + t) (deftest every.8 (let ((x '(1)) (args nil)) - (not - (loop for i from 1 below (1- (min 100 call-arguments-limit)) - do (push x args) - always (apply #'every #'= args)))) - nil) + (loop for i from 1 below (1- (min 100 call-arguments-limit)) + do (push x args) + always (apply #'every #'= args))) + t) (deftest every.9 - (not (every #'zerop #*000000000000)) - nil) + (notnot-mv (every #'zerop #*000000000000)) + t) (deftest every.10 - (not (every #'zerop #*)) - nil) + (notnot-mv (every #'zerop #*)) + t) (deftest every.11 (every #'zerop #*0000010000) nil) (deftest every.12 - (not (every #'(lambda (x) (eql x #\a)) "aaaaaaaa")) - nil) + (notnot-mv (every #'(lambda (x) (eql x #\a)) "aaaaaaaa")) + t) (deftest every.13 - (not (every #'(lambda (x) (eql x #\a)) "")) - nil) + (notnot-mv (every #'(lambda (x) (eql x #\a)) "")) + t) (deftest every.14 (every #'(lambda (x) (eql x #\a)) "aaaaaabaaaa") @@ -76,8 +75,8 @@ nil) (deftest every.16 - (not (every 'null '(nil nil nil nil))) - nil) + (notnot-mv (every 'null '(nil nil nil nil))) + t) ;;; Error cases @@ -108,7 +107,7 @@ (deftest every.error.7 (classify-error (every #'eq () 'a)) type-error) - +` (deftest every.error.8 (classify-error (every)) program-error) diff --git a/ansi-tests/fboundp.lsp b/ansi-tests/fboundp.lsp index 2abfd632..b348dfd8 100644 --- a/ansi-tests/fboundp.lsp +++ b/ansi-tests/fboundp.lsp @@ -6,15 +6,15 @@ (in-package :cl-test) (deftest fboundp.1 - (not (fboundp 'car)) + (not-mv (fboundp 'car)) nil) (deftest fboundp.2 - (not (fboundp 'cdr)) + (not-mv (fboundp 'cdr)) nil) (deftest fboundp.3 - (not (fboundp 'defun)) ; a macro + (not-mv (fboundp 'defun)) ; a macro nil) (deftest fboundp.4 @@ -24,7 +24,7 @@ (defun fboundp-5-fn (x) x) (deftest fboundp.5 - (not (fboundp 'fboundp-5-fn)) + (not-mv (fboundp 'fboundp-5-fn)) nil) (eval-when (eval compile) @@ -32,7 +32,7 @@ (defun (setf fboundp-6-accessor) (y x) (setf (car x) y)))) (deftest fboundp.6 - (not (fboundp '(setf fboundp-6-accessor))) + (not-mv (fboundp '(setf fboundp-6-accessor))) nil) (deftest fboundp.7 diff --git a/ansi-tests/fmakunbound.lsp b/ansi-tests/fmakunbound.lsp index a9585417..e3b56048 100644 --- a/ansi-tests/fmakunbound.lsp +++ b/ansi-tests/fmakunbound.lsp @@ -10,7 +10,7 @@ (and (not (fboundp g)) (setf (symbol-function g) #'car) (fboundp g) - (values (eqt (fmakunbound g) g) + (values (eqt (check-values (fmakunbound g)) g) (fboundp g)))) t nil) @@ -19,7 +19,7 @@ (and (not (fboundp g)) (eval `(defun ,g () nil)) (fboundp g) - (values (eqt (fmakunbound g) g) + (values (eqt (check-values (fmakunbound g)) g) (fboundp g)))) t nil) @@ -28,7 +28,7 @@ (and (not (fboundp g)) (eval `(defmacro ,g () nil)) (fboundp g) - (values (eqt (fmakunbound g) g) + (values (eqt (check-values (fmakunbound g)) g) (fboundp g)))) t nil) @@ -38,7 +38,7 @@ (and (not (fboundp n)) (eval `(defun ,n () nil)) (fboundp n) - (values (equal (fmakunbound n) n) + (values (equal (check-values (fmakunbound n)) n) (fboundp n)))) t nil) diff --git a/ansi-tests/function.lsp b/ansi-tests/function.lsp index 84066c23..f6039c65 100644 --- a/ansi-tests/function.lsp +++ b/ansi-tests/function.lsp @@ -21,7 +21,7 @@ nil) (deftest function.3 - (not (typep #'identity 'function)) + (not-mv (typep #'identity 'function)) nil) (deftest function.4 @@ -52,15 +52,15 @@ (defun (setf function-7-accessor) (y x) (setf (car x) y) y))) (deftest function.7 - (not (typep #'(setf function-7-accessor) 'function)) + (not-mv (typep #'(setf function-7-accessor) 'function)) nil) (deftest function.8 - (not (typep #'(lambda (x) x) 'function)) + (not-mv (typep #'(lambda (x) x) 'function)) nil) (deftest function.9 - (not (typep (compile nil '(lambda (x) x)) 'function)) + (not-mv (typep (compile nil '(lambda (x) x)) 'function)) nil) ;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL. @@ -79,11 +79,11 @@ nil) (deftest function.12 - (flet ((%f () nil)) (not (typep #'%f 'function))) + (flet ((%f () nil)) (not-mv (typep #'%f 'function))) nil) (deftest function.13 - (labels ((%f () nil)) (not (typep #'%f 'function))) + (labels ((%f () nil)) (not-mv (typep #'%f 'function))) nil) ;;; "If name is a function name, the functional definition of that @@ -91,5 +91,5 @@ ;;; labels, or macrolet form, if there is one." (page for FUNCTION, sec. 5.3) ;;; ^^^^^^^^ ;;;(deftest function.14 -;;; (macrolet ((%f () nil)) (not (typep #'%f 'function))) +;;; (macrolet ((%f () nil)) (not-mv (typep #'%f 'function))) ;;; nil) diff --git a/ansi-tests/functionp.lsp b/ansi-tests/functionp.lsp index 1bc0e142..4910d025 100644 --- a/ansi-tests/functionp.lsp +++ b/ansi-tests/functionp.lsp @@ -51,15 +51,15 @@ (defun (setf functionp-7-accessor) (y x) (setf (car x) y) y))) (deftest functionp.7 - (not (functionp #'(setf functionp-7-accessor))) + (not-mv (functionp #'(setf functionp-7-accessor))) nil) (deftest functionp.8 - (not (functionp #'(lambda (x) x))) + (not-mv (functionp #'(lambda (x) x))) nil) (deftest functionp.9 - (not (functionp (compile nil '(lambda (x) x)))) + (not-mv (functionp (compile nil '(lambda (x) x)))) nil) ;;; In ANSI CL, symbols and cons can no longer be functions @@ -77,13 +77,13 @@ nil) (deftest functionp.12 - (flet ((%f () nil)) (not (functionp #'%f))) + (flet ((%f () nil)) (not-mv (functionp #'%f))) nil) -(deftest functionp.13 +(deftest functionp.error.1 (classify-error (functionp)) program-error) -(deftest functionp.14 +(deftest functionp.error.2 (classify-error (functionp #'cons nil)) program-error) diff --git a/ansi-tests/identity.lsp b/ansi-tests/identity.lsp index 4394ce2c..03f0ca28 100644 --- a/ansi-tests/identity.lsp +++ b/ansi-tests/identity.lsp @@ -7,17 +7,17 @@ (deftest identity.1 (loop for x in *universe* - always (eqlt x (identity x))) + always (eqlt x (check-values (identity x)))) t) (deftest identity.2 (let ((x (ash 1 100))) - (eqlt x (identity x))) + (eqlt x (check-values (identity x)))) t) (deftest identity.3 (let ((x 1.00000001)) - (eqlt x (identity x))) + (eqlt x (check-values (identity x)))) t) (deftest identity.error.1 diff --git a/ansi-tests/lambda-list-keywords.lsp b/ansi-tests/lambda-list-keywords.lsp index 59b8b694..856727da 100644 --- a/ansi-tests/lambda-list-keywords.lsp +++ b/ansi-tests/lambda-list-keywords.lsp @@ -7,21 +7,21 @@ ;;; The variable is bound (deftest lambda-list-keywords.1 - (not (boundp 'lambda-list-keywords)) + (not-mv (boundp 'lambda-list-keywords)) nil) ;;; The variable is a constant (deftest lambda-list-keywords.2 - (not (constantp 'lambda-list-keywords)) + (not-mv (constantp 'lambda-list-keywords)) nil) ;;; The standard keywords are present in the list (deftest lambda-list-keywords.3 (and (consp lambda-list-keywords) - (null (set-difference '(&allow-other-keys - &aux &body &environment - &key &optional &rest &whole) - lambda-list-keywords))) + (not-mv (set-difference '(&allow-other-keys + &aux &body &environment + &key &optional &rest &whole) + lambda-list-keywords))) t) ;;; No lambda list keywords are in the keyword package @@ -37,6 +37,3 @@ (eql (aref name 0) #\&)))) lambda-list-keywords) nil) - - - diff --git a/ansi-tests/length.lsp b/ansi-tests/length.lsp index b0e1ab327600cad335635cce2c475bf9f2830ccd..3706d72d4d7a623a7fc5d4761e9e6e68484a7ee0 100644 GIT binary patch delta 83 zcmX>nbVg`HB%_2zPHKsQhDL>ghNh+_mjV!I<mBfUa7`{}ROHntD9TUI1B)ssOkTvO eB@9vk1R4dU#Tg2j3Kc*-lkYH^ZWd;;W(NS34;3c> delta 83 zcmX>jbWUhPB%_>yf<{hiiGqekg@T5rrY4sH7-;0==NACklM5LYfs{r;QGR+J7w6>p cj9LPmKyGPqhC-%71z7#$JB+5A`I&6l0eT)3?f?J) diff --git a/ansi-tests/map-into.lsp b/ansi-tests/map-into.lsp index e70cb4c8..48df0e62 100644 --- a/ansi-tests/map-into.lsp +++ b/ansi-tests/map-into.lsp @@ -174,7 +174,7 @@ t "1234") -`w(deftest map-into-string.4 +(deftest map-into-string.4 (let ((a (make-array 6 :initial-element #\x :element-type 'character :fill-pointer 3))) diff --git a/ansi-tests/merge.lsp b/ansi-tests/merge.lsp index 0fa32f1b..617d0a1b 100644 --- a/ansi-tests/merge.lsp +++ b/ansi-tests/merge.lsp @@ -486,7 +486,7 @@ ;;; Tests of error situations (deftest merge.error.1 - (handler-case (merge 'symbol (list 1 2 3) (list 4 5 6) #'<) + (handler-case (eval '(merge 'symbol (list 1 2 3) (list 4 5 6) #'<)) (error () :caught)) :caught) diff --git a/ansi-tests/multiple-value-prog1.lsp b/ansi-tests/multiple-value-prog1.lsp index d13364c0..d8ab80cd 100644 --- a/ansi-tests/multiple-value-prog1.lsp +++ b/ansi-tests/multiple-value-prog1.lsp @@ -48,7 +48,7 @@ (deftest multiple-value-prog1.8 (let* ((n (min 100 multiple-values-limit))) - (not + (not-mv (loop for i from 0 below n for x = (make-int-list i) always diff --git a/ansi-tests/nil.lsp b/ansi-tests/nil.lsp index afa63b94..b0f56741 100644 --- a/ansi-tests/nil.lsp +++ b/ansi-tests/nil.lsp @@ -18,7 +18,7 @@ nil) (deftest nil.3 - (not (constantp nil)) + (not-mv (constantp nil)) nil) (deftest nil.4 diff --git a/ansi-tests/notany.lsp b/ansi-tests/notany.lsp index 0a4c1a3f..ab6b1880 100644 --- a/ansi-tests/notany.lsp +++ b/ansi-tests/notany.lsp @@ -6,11 +6,11 @@ (in-package :cl-test) (deftest notany.1 - (not (notany #'identity nil)) + (not-mv (notany #'identity nil)) nil) (deftest notany.2 - (not (notany #'identity #())) + (not-mv (notany #'identity #())) nil) (deftest notany.3 @@ -22,11 +22,11 @@ nil 4) (deftest notany.4 - (not (notany #'/= '(1 2 3 4) '(1 2 3 4 5))) + (not-mv (notany #'/= '(1 2 3 4) '(1 2 3 4 5))) nil) (deftest notany.5 - (not (notany #'/= '(1 2 3 4 5) '(1 2 3 4))) + (not-mv (notany #'/= '(1 2 3 4 5) '(1 2 3 4))) nil) (deftest notany.6 @@ -34,7 +34,7 @@ nil) (deftest notany.7 - (not (notany #'(lambda (x y) (and x y)) + (not-mv (notany #'(lambda (x y) (and x y)) '(nil t t nil t) #(t nil nil t nil nil))) nil) @@ -48,11 +48,11 @@ nil) (deftest notany.9 - (not (notany #'zerop #*11111111111111)) + (not-mv (notany #'zerop #*11111111111111)) nil) (deftest notany.10 - (not (notany #'zerop #*)) + (not-mv (notany #'zerop #*)) nil) (deftest notany.11 @@ -60,11 +60,11 @@ nil) (deftest notany.12 - (not (notany #'(lambda (x) (not (eql x #\a))) "aaaaaaaa")) + (not-mv (notany #'(lambda (x) (not (eql x #\a))) "aaaaaaaa")) nil) (deftest notany.13 - (not (notany #'(lambda (x) (eql x #\a)) "")) + (not-mv (notany #'(lambda (x) (eql x #\a)) "")) nil) (deftest notany.14 @@ -72,7 +72,7 @@ nil) (deftest notany.15 - (not (notany 'null '(1 2 3 4))) + (not-mv (notany 'null '(1 2 3 4))) nil) (deftest notany.16 diff --git a/ansi-tests/notevery.lsp b/ansi-tests/notevery.lsp index 9f85ba41..16bd3dcb 100644 --- a/ansi-tests/notevery.lsp +++ b/ansi-tests/notevery.lsp @@ -30,7 +30,7 @@ nil) (deftest notevery.6 - (not (notevery #'= '(1 2 3 4 5) '(1 2 3 4 6))) + (not-mv (notevery #'= '(1 2 3 4 5) '(1 2 3 4 6))) nil) (deftest notevery.7 @@ -56,7 +56,7 @@ nil) (deftest notevery.11 - (not (notevery #'zerop #*0000010000)) + (not-mv (notevery #'zerop #*0000010000)) nil) (deftest notevery.12 @@ -68,11 +68,11 @@ nil) (deftest notevery.14 - (not (notevery #'(lambda (x) (eql x #\a)) "aaaaaabaaaa")) + (not-mv (notevery #'(lambda (x) (eql x #\a)) "aaaaaabaaaa")) nil) (deftest notevery.15 - (not (notevery 'null '(nil nil t nil))) + (not-mv (notevery 'null '(nil nil t nil))) nil) (deftest notevery.16 diff --git a/ansi-tests/packages-03.lsp b/ansi-tests/packages-03.lsp index eab71ff5..0dd7ebaf 100644 --- a/ansi-tests/packages-03.lsp +++ b/ansi-tests/packages-03.lsp @@ -29,7 +29,7 @@ ;; The list returned has only packages in it (deftest list-all-packages-3 - (notnot (every #'packagep (list-all-packages))) + (notnot-mv (every #'packagep (list-all-packages))) t) ;; It returns a list of the same packages each time it is called @@ -65,12 +65,12 @@ "A") (deftest package-name-5 - (notnot (member (classify-error (package-name "NOT-THERE")) + (notnot-mv (member (classify-error (package-name "NOT-THERE")) '(type-error package-error))) t) (deftest package-name-6 - (notnot (member (classify-error (package-name #\*)) + (notnot-mv (member (classify-error (package-name #\*)) '(type-error package-error))) t) @@ -185,7 +185,7 @@ ("Q")) (deftest package-nicknames-11 - (notnot (member (classify-error (package-nicknames "NOT-A-PACKAGE-NAME")) + (notnot-mv (member (classify-error (package-nicknames "NOT-A-PACKAGE-NAME")) '(type-error package-error))) t) diff --git a/ansi-tests/packages-04.lsp b/ansi-tests/packages-04.lsp index 016f20ae..638fadab 100644 --- a/ansi-tests/packages-04.lsp +++ b/ansi-tests/packages-04.lsp @@ -13,10 +13,10 @@ (progn (safely-delete-package "TEMP1") (let ((p (make-package "TEMP1"))) - (multiple-value-bind (sym1 status1) + (multiple-value-bind* (sym1 status1) (find-symbol "FOO" p) (intern "FOO" p) - (multiple-value-bind (sym2 status2) + (multiple-value-bind* (sym2 status2) (find-symbol "FOO" p) (and (null sym1) (null status1) @@ -30,10 +30,10 @@ (progn (safely-delete-package "TEMP1") (let ((p (make-package "TEMP1"))) - (multiple-value-bind (sym1 status1) + (multiple-value-bind* (sym1 status1) (find-symbol "FOO" "TEMP1") (intern "FOO" "TEMP1") - (multiple-value-bind (sym2 status2) + (multiple-value-bind* (sym2 status2) (find-symbol "FOO" p) (and (null sym1) (null status1) diff --git a/ansi-tests/packages-05.lsp b/ansi-tests/packages-05.lsp index 84ddfcce..79b27a4e 100644 --- a/ansi-tests/packages-05.lsp +++ b/ansi-tests/packages-05.lsp @@ -15,7 +15,7 @@ (let ((p (make-package "TEST1"))) (let ((sym (intern "FOO" p))) (setf return-value (export sym p)) - (multiple-value-bind (sym2 status) + (multiple-value-bind* (sym2 status) (find-symbol "FOO" p) (prog1 (and sym2 @@ -33,7 +33,7 @@ (let ((p (make-package "TEST1"))) (let ((sym (intern "FOO" p))) (export (list sym) p) - (multiple-value-bind (sym2 status) + (multiple-value-bind* (sym2 status) (find-symbol "FOO" p) (prog1 (and sym2 diff --git a/ansi-tests/packages-07.lsp b/ansi-tests/packages-07.lsp index 2dfc1560..499ba915 100644 --- a/ansi-tests/packages-07.lsp +++ b/ansi-tests/packages-07.lsp @@ -21,12 +21,12 @@ (p2 (make-package "TEST5" :use '("TEST4"))) (r1 (package-shadowing-symbols "TEST4")) (r2 (package-shadowing-symbols "TEST5"))) - (multiple-value-bind (s1 kind1) + (multiple-value-bind* (s1 kind1) (find-symbol "A" p1) - (multiple-value-bind (s2 kind2) + (multiple-value-bind* (s2 kind2) (find-symbol "A" p2) (let ((r3 (shadow "A" p2))) - (multiple-value-bind (s3 kind3) + (multiple-value-bind* (s3 kind3) (find-symbol "A" p2) (list (package-name p1) @@ -61,12 +61,12 @@ (p2 (make-package "H" :use '("G"))) (r1 (package-shadowing-symbols "G")) (r2 (package-shadowing-symbols "H"))) - (multiple-value-bind (s1 kind1) + (multiple-value-bind* (s1 kind1) (find-symbol "A" p1) - (multiple-value-bind (s2 kind2) + (multiple-value-bind* (s2 kind2) (find-symbol "A" p2) (let ((r3 (shadow "A" "H"))) - (multiple-value-bind (s3 kind3) + (multiple-value-bind* (s3 kind3) (find-symbol "A" p2) (prog1 (list (package-name p1) (package-name p2) @@ -99,12 +99,12 @@ (p2 (make-package "H" :use '("G"))) (r1 (package-shadowing-symbols "G")) (r2 (package-shadowing-symbols "H"))) - (multiple-value-bind (s1 kind1) + (multiple-value-bind* (s1 kind1) (find-symbol "A" p1) - (multiple-value-bind (s2 kind2) + (multiple-value-bind* (s2 kind2) (find-symbol "A" p2) (let ((r3 (shadow "A" #\H))) - (multiple-value-bind (s3 kind3) + (multiple-value-bind* (s3 kind3) (find-symbol "A" p2) (prog1 (list (package-name p1) (package-name p2) @@ -134,7 +134,7 @@ (make-package :G) (let ((s1 (intern "X" :G))) (shadow "X" :G) - (multiple-value-bind (s2 kind) + (multiple-value-bind* (s2 kind) (find-symbol "X" :G) (list (eqt s1 s2) (symbol-name s2) @@ -156,10 +156,10 @@ (export (intern "X" :G) :G) (make-package :H :use '("G")) (shadow "X" :H) - (multiple-value-bind (s1 kind1) + (multiple-value-bind* (s1 kind1) (find-symbol "X" :H) (shadow "X" :H) - (multiple-value-bind (s2 kind2) + (multiple-value-bind* (s2 kind2) (find-symbol "X" :H) (list (eqt s1 s2) kind1 kind2)))) (error (c) c)) diff --git a/ansi-tests/packages-11.lsp b/ansi-tests/packages-11.lsp index 2683c82d..db1b88e1 100644 --- a/ansi-tests/packages-11.lsp +++ b/ansi-tests/packages-11.lsp @@ -15,10 +15,10 @@ (safely-delete-package "X") (let* ((p (make-package "X" :use nil)) (r (export (intern "X" p) p))) - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "X" p) (unexport sym1 p) - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "X" p) (and (eqt r t) (eqt sym1 sym2) @@ -35,10 +35,10 @@ (safely-delete-package "X") (let* ((p (make-package "X" :use nil)) (r (export (intern "X" p) p))) - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "X" p) (unexport (list sym1) "X") - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "X" p) (and (eqt sym1 sym2) (eqt r t) @@ -56,14 +56,14 @@ (let* ((p (make-package "X" :use nil)) (r1 (export (intern "X" p) p)) (r2 (export (intern "Y" p) p))) - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "X" p) - (multiple-value-bind (sym1a access1a) + (multiple-value-bind* (sym1a access1a) (find-symbol "Y" p) (unexport (list sym1 sym1a) '#:|X|) - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "X" p) - (multiple-value-bind (sym2a access2a) + (multiple-value-bind* (sym2a access2a) (find-symbol "Y" p) (and (eqt sym1 sym2) (eqt sym1a sym2a) @@ -85,10 +85,10 @@ (safely-delete-package "X") (let* ((p (make-package "X" :use nil)) (r (export (intern "X" p) p))) - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "X" p) (unexport (list sym1) #\X) - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "X" p) (and (eqt sym1 sym2) (eqt r t) @@ -121,7 +121,7 @@ (let ((p (make-package "X" :use nil))) (let* ((sym (intern "FOO" p)) (r (unexport sym p))) - (multiple-value-bind (sym2 access) + (multiple-value-bind* (sym2 access) (find-symbol "FOO" p) (and (eqt r t) (eqt access :internal) diff --git a/ansi-tests/packages-12.lsp b/ansi-tests/packages-12.lsp index ae692f63..85406d73 100644 --- a/ansi-tests/packages-12.lsp +++ b/ansi-tests/packages-12.lsp @@ -18,7 +18,7 @@ (prog1 (let ((p (make-package "H"))) (intern "FOO" p) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "FOO" p) (and (eqt access :internal) @@ -37,7 +37,7 @@ (let ((*PACKAGE* (make-package "H"))) (declare (special *PACKAGE*)) (intern "FOO") - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "FOO") (and (eqt access :internal) @@ -54,7 +54,7 @@ (prog1 (let ((p (make-package "H"))) (intern "FOO" p) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "FOO" p) (and (eqt access :internal) @@ -71,7 +71,7 @@ (prog1 (let ((p (make-package "H"))) (intern "FOO" p) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "FOO" p) (and (eqt access :internal) @@ -89,7 +89,7 @@ (prog1 (let ((p (make-package "H"))) (intern "FOO" p) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "FOO" p) (and (eqt access :internal) @@ -116,7 +116,7 @@ (export (intern "FOO" "H") "H") ;; At this point, G:FOO is also an external ;; symbol of H. - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "FOO" "H") (and sym1 (eqt access1 :external) @@ -124,7 +124,7 @@ (eqt (find-package "G") (symbol-package sym1)) (unintern sym1 "H") - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "FOO" "H") (and (eqt sym1 sym2) (eqt (symbol-package sym1) @@ -146,7 +146,7 @@ (error (c) (return-from failed (list :shadow-error c)))) (export (intern "FOO" pg) pg) ;; At this point, H::FOO shadows G:FOO - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "FOO" ph) (and sym1 @@ -154,7 +154,7 @@ (eqt access1 :internal) (equal (list sym1) (package-shadowing-symbols ph)) (unintern sym1 ph) - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "FOO" ph) (and (not (eqt sym1 sym2)) (eqt access2 :inherited) @@ -179,7 +179,7 @@ (gsym2 (intern "FOO" pg2))) (export gsym1 pg1) (export gsym2 pg2) - (multiple-value-bind (sym1 access1) + (multiple-value-bind* (sym1 access1) (find-symbol "FOO" ph) (and (equal (list sym1) (package-shadowing-symbols ph)) @@ -217,7 +217,7 @@ (export gsym pg3) (export gsym pg1) (export gsym pg2) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "FOO" ph) (and (equal (list sym) (package-shadowing-symbols ph)) @@ -227,7 +227,7 @@ (eqt access :internal) (handler-case (and (unintern sym ph) - (multiple-value-bind (sym2 access2) + (multiple-value-bind* (sym2 access2) (find-symbol "FOO" ph) (and (eqt gsym sym2) (eqt access2 :inherited)))) diff --git a/ansi-tests/packages-16.lsp b/ansi-tests/packages-16.lsp index 52bfb792..c893898f 100644 --- a/ansi-tests/packages-16.lsp +++ b/ansi-tests/packages-16.lsp @@ -112,13 +112,13 @@ (mapcar #'notnot (list - (not (not (packagep p))) + (packagep p) (equal (package-name p) "H") (equal (package-use-list p) nil) (equal (package-used-by-list p) nil) (equal (package-nicknames p) nil) (eql (num-symbols-in-package p) 1) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "foo" p) (and (eqt access :internal) (equal (symbol-name sym) "foo") @@ -143,13 +143,13 @@ (mapcar #'notnot (list - (not (not (packagep p))) + (packagep p) (equal (package-name p) "H") (equal (package-use-list p) nil) (equal (package-used-by-list p) nil) (equal (package-nicknames p) nil) (eql (num-symbols-in-package p) 1) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "f" p) (and (eqt access :internal) (equal (symbol-name sym) "f") @@ -188,13 +188,13 @@ (mapcar #'notnot (list - (not (not (packagep p))) + (packagep p) (equal (package-name p) "H") (equal (package-use-list p) nil) (equal (package-used-by-list p) nil) (equal (package-nicknames p) nil) (eql (num-symbols-in-package p) 1) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "A" p) (and (eqt access :internal) (equal (symbol-name sym) "A") @@ -231,19 +231,19 @@ (mapcar #'notnot (list - (not (not (packagep p))) + (packagep p) (equal (package-name p) "H") (equal (package-use-list p) nil) (equal (package-used-by-list p) nil) (equal (package-nicknames p) nil) (equal (package-shadowing-symbols p) nil) (eql (num-symbols-in-package p) 2) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "A" p) (and (eqt access :internal) (equal (symbol-name sym) "A") (equal (symbol-package sym) pg))) - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol "B" p) (and (eqt access :internal) (equal (symbol-name sym) "B") @@ -270,7 +270,7 @@ (mapcar #'notnot (list - (not (not (packagep p))) + (packagep p) (equal (package-name p) "H") (equal (package-use-list p) nil) (equal (package-used-by-list p) nil) @@ -280,7 +280,7 @@ (loop for s in '("Q" "Z" "R") do (unless - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol s p) (and (eqt access :external) (equal (symbol-name sym) s) @@ -306,7 +306,7 @@ (mapcar #'notnot (list - (not (not (packagep p))) + (packagep p) (equal (package-name p) "H") (equal (package-use-list p) nil) (equal (package-used-by-list p) nil) @@ -316,7 +316,7 @@ (loop for s in '("Q" "Z" "R") do (unless - (multiple-value-bind (sym access) + (multiple-value-bind* (sym access) (find-symbol s p) (and (eqt access :internal) (equal (symbol-name sym) s) @@ -572,7 +572,7 @@ (unless (every #'(lambda (str acc pkg) - (multiple-value-bind + (multiple-value-bind* (sym access) (find-symbol str p) (or diff --git a/ansi-tests/packages-18.lsp b/ansi-tests/packages-18.lsp index a5141a44..6afc6cde 100644 --- a/ansi-tests/packages-18.lsp +++ b/ansi-tests/packages-18.lsp @@ -25,7 +25,7 @@ ;; *package* is always a package (deftest packagep-2 - (not (packagep *package*)) + (not-mv (packagep *package*)) nil) (deftest packagep.error.1 diff --git a/ansi-tests/simple-vector-p.lsp b/ansi-tests/simple-vector-p.lsp index 76efc340..f5857f88 100644 --- a/ansi-tests/simple-vector-p.lsp +++ b/ansi-tests/simple-vector-p.lsp @@ -16,7 +16,7 @@ nil) (deftest simple-vector-p.2 - (notnot (simple-vector-p (make-array '(10)))) + (notnot-mv (simple-vector-p (make-array '(10)))) t) (deftest simple-vector-p.3 @@ -24,7 +24,7 @@ nil) (deftest simple-vector-p.4 - (notnot (simple-vector-p (vector 'a 'b 'c))) + (notnot-mv (simple-vector-p (vector 'a 'b 'c))) t) (deftest simple-vector-p.5 diff --git a/ansi-tests/some.lsp b/ansi-tests/some.lsp index 2413943a..c0c3b756 100644 --- a/ansi-tests/some.lsp +++ b/ansi-tests/some.lsp @@ -30,7 +30,7 @@ nil) (deftest some.6 - (not (some #'/= '(1 2 3 4 5) '(1 2 3 4 6))) + (not-mv (some #'/= '(1 2 3 4 5) '(1 2 3 4 6))) nil) (deftest some.7 @@ -55,7 +55,7 @@ nil) (deftest some.11 - (not (some #'zerop #*1111111011111)) + (not-mv (some #'zerop #*1111111011111)) nil) (deftest some.12 @@ -67,7 +67,7 @@ nil) (deftest some.14 - (not (some #'(lambda (x) (not (eql x #\a))) "aaaaaabaaaa")) + (not-mv (some #'(lambda (x) (not (eql x #\a))) "aaaaaabaaaa")) nil) (deftest some.15 @@ -75,7 +75,7 @@ nil) (deftest some.16 - (not (some 'null '(1 2 3 nil 5))) + (not-mv (some 'null '(1 2 3 nil 5))) nil) diff --git a/ansi-tests/structure-00.lsp b/ansi-tests/structure-00.lsp index e67914fb..bee7c130 100644 --- a/ansi-tests/structure-00.lsp +++ b/ansi-tests/structure-00.lsp @@ -290,7 +290,7 @@ do the defstruct." (functionp (function ,p-fn)) (symbol-function (quote ,p-fn)) (notnot (funcall #',p-fn s)) - (notnot (,p-fn s)) + (notnot-mv (,p-fn s)) )) t) (deftest ,(make-struct-test-name name "ERROR.1") @@ -455,7 +455,7 @@ do the defstruct." for read-only in slot-read-only for field-fn in field-fns when read-only - collect `(not (fboundp '(setf ,field-fn)))) + collect `(not-mv (fboundp '(setf ,field-fn)))) t) t))) @@ -464,14 +464,14 @@ do the defstruct." ,@(unless type-option `( (deftest ,(make-struct-test-name name 13) - (notnot (typep (,make-fn) (find-class (quote ,name)))) + (notnot-mv (typep (,make-fn) (find-class (quote ,name)))) t) (deftest ,(make-struct-test-name name 14) (let ((class (find-class (quote ,name)))) - (notnot (typep class 'structure-class))) + (notnot-mv (typep class 'structure-class))) t) (deftest ,(make-struct-test-name name 15) - (notnot (typep (,make-fn) 'structure-object)) + (notnot-mv (typep (,make-fn) 'structure-object)) t) (deftest ,(make-struct-test-name name 16) (loop for type in *disjoint-types-list* diff --git a/ansi-tests/structures-01.lsp b/ansi-tests/structures-01.lsp index 51009854..022adffe 100644 --- a/ansi-tests/structures-01.lsp +++ b/ansi-tests/structures-01.lsp @@ -21,83 +21,83 @@ ;; Test that make-s-1 produces objects ;; of the correct type (deftest structure-1-1 - (not (not (typep (make-s-1) 's-1))) + (notnot-mv (typep (make-s-1) 's-1)) t) ;; Test that the -p predicate exists (deftest structure-1-2 - (not (not (s-1-p (make-s-1)))) + (notnot-mv (s-1-p (make-s-1))) t) ;; Test that all the objects in the universe are ;; not of this type (deftest structure-1-3 - (count-if #'s-1-p *universe*) + (count-if #'s-1-p *universe*) 0) (deftest structure-1-4 - (count-if #'(lambda (x) (typep x 's-1)) *universe*) + (count-if #'(lambda (x) (typep x 's-1)) *universe*) 0) ;; Check that the fields can be read after being initialized (deftest structure-1-5 - (s-1-foo (make-s-1 :foo 'a)) + (s-1-foo (make-s-1 :foo 'a)) a) (deftest structure-1-6 - (s-1-bar (make-s-1 :bar 'b)) + (s-1-bar (make-s-1 :bar 'b)) b) (deftest structure-1-7 - (let ((s (make-s-1 :foo 'c :bar 'd))) - (list (s-1-foo s) (s-1-bar s))) + (let ((s (make-s-1 :foo 'c :bar 'd))) + (list (s-1-foo s) (s-1-bar s))) (c d)) ;; Can setf the fields (deftest structure-1-8 - (let ((s (make-s-1))) - (setf (s-1-foo s) 'e) - (setf (s-1-bar s) 'f) - (list (s-1-foo s) (s-1-bar s))) + (let ((s (make-s-1))) + (setf (s-1-foo s) 'e) + (setf (s-1-bar s) 'f) + (list (s-1-foo s) (s-1-bar s))) (e f)) (deftest structure-1-9 - (let ((s (make-s-1 :foo 'a :bar 'b))) - (setf (s-1-foo s) 'e) - (setf (s-1-bar s) 'f) - (list (s-1-foo s) (s-1-bar s))) + (let ((s (make-s-1 :foo 'a :bar 'b))) + (setf (s-1-foo s) 'e) + (setf (s-1-bar s) 'f) + (list (s-1-foo s) (s-1-bar s))) (e f)) ;; copier function defined (deftest structure-1-10 - (let ((s (make-s-1 :foo 'a :bar 'b))) - (let ((s2 (copy-s-1 s))) - (setf (s-1-foo s) nil) - (setf (s-1-bar s) nil) - (list (s-1-foo s2) - (s-1-bar s2)))) + (let ((s (make-s-1 :foo 'a :bar 'b))) + (let ((s2 (copy-s-1 s))) + (setf (s-1-foo s) nil) + (setf (s-1-bar s) nil) + (list (s-1-foo s2) + (s-1-bar s2)))) (a b)) ;; Make produces unique items (deftest structure-1-11 - (eqt (make-s-1) (make-s-1)) + (eqt (make-s-1) (make-s-1)) nil) (deftest structure-1-12 - (eqt (make-s-1 :foo 'a :bar 'b) - (make-s-1 :foo 'a :bar 'b)) + (eqt (make-s-1 :foo 'a :bar 'b) + (make-s-1 :foo 'a :bar 'b)) nil) ;; More type and class checks (deftest structure-1-13 - (not (not (typep (class-of (make-s-1)) 'structure-class))) + (notnot-mv (typep (class-of (make-s-1)) 'structure-class)) t) (deftest structure-1-14 - (not (not (typep (make-s-1) 'structure-object))) + (notnot-mv (typep (make-s-1) 'structure-object)) t) (deftest structure-1-15 - (subtypep* 's-1 'structure-object) + (subtypep* 's-1 'structure-object) t t) diff --git a/ansi-tests/t.lsp b/ansi-tests/t.lsp index 84dd79d5..eecb697d 100644 --- a/ansi-tests/t.lsp +++ b/ansi-tests/t.lsp @@ -9,7 +9,7 @@ t t) (deftest t.2 - (not (constantp t)) + (not-mv (constantp t)) nil) (deftest t.3 -- GitLab