Commit 556f97c6 authored by pfdietz's avatar pfdietz

Added uses of notnot-mv to better detect multiple value returns. Added more...

Added uses of notnot-mv to better detect multiple value returns.  Added more VECTOR type tests.  Some cleanups.
parent ff2a505b
...@@ -19,7 +19,7 @@ ...@@ -19,7 +19,7 @@
(deftest array-displacement.7 (deftest array-displacement.7
(let* ((a (make-array '(10))) (let* ((a (make-array '(10)))
(b (make-array '(10) :displaced-to a))) (b (make-array '(10) :displaced-to a)))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 0)))) (eqlt disp 0))))
...@@ -28,7 +28,7 @@ ...@@ -28,7 +28,7 @@
(deftest array-displacement.8 (deftest array-displacement.8
(let* ((a (make-array '(10))) (let* ((a (make-array '(10)))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2))) (b (make-array '(5) :displaced-to a :displaced-index-offset 2)))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 2)))) (eqlt disp 2))))
...@@ -38,7 +38,7 @@ ...@@ -38,7 +38,7 @@
(let* ((a (make-array '(10) :element-type 'base-char)) (let* ((a (make-array '(10) :element-type 'base-char))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2 (b (make-array '(5) :displaced-to a :displaced-index-offset 2
:element-type 'base-char))) :element-type 'base-char)))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 2)))) (eqlt disp 2))))
...@@ -48,7 +48,7 @@ ...@@ -48,7 +48,7 @@
(let* ((a (make-array '(10) :element-type 'base-char)) (let* ((a (make-array '(10) :element-type 'base-char))
(b (make-array '(5) :displaced-to a (b (make-array '(5) :displaced-to a
:element-type 'base-char))) :element-type 'base-char)))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 0)))) (eqlt disp 0))))
...@@ -58,7 +58,7 @@ ...@@ -58,7 +58,7 @@
(let* ((a (make-array '(10) :element-type 'bit)) (let* ((a (make-array '(10) :element-type 'bit))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2 (b (make-array '(5) :displaced-to a :displaced-index-offset 2
:element-type 'bit))) :element-type 'bit)))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 2)))) (eqlt disp 2))))
...@@ -68,7 +68,7 @@ ...@@ -68,7 +68,7 @@
(let* ((a (make-array '(10) :element-type 'bit)) (let* ((a (make-array '(10) :element-type 'bit))
(b (make-array '(5) :displaced-to a (b (make-array '(5) :displaced-to a
:element-type 'bit))) :element-type 'bit)))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 0)))) (eqlt disp 0))))
...@@ -78,7 +78,7 @@ ...@@ -78,7 +78,7 @@
(let* ((a (make-array '(10) :element-type '(integer 0 255))) (let* ((a (make-array '(10) :element-type '(integer 0 255)))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2 (b (make-array '(5) :displaced-to a :displaced-index-offset 2
:element-type '(integer 0 255)))) :element-type '(integer 0 255))))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 2)))) (eqlt disp 2))))
...@@ -88,7 +88,7 @@ ...@@ -88,7 +88,7 @@
(let* ((a (make-array '(10) :element-type '(integer 0 255))) (let* ((a (make-array '(10) :element-type '(integer 0 255)))
(b (make-array '(5) :displaced-to a (b (make-array '(5) :displaced-to a
:element-type '(integer 0 255)))) :element-type '(integer 0 255))))
(multiple-value-bind (dt disp) (multiple-value-bind* (dt disp)
(array-displacement b) (array-displacement b)
(and (eqt a dt) (and (eqt a dt)
(eqlt disp 0)))) (eqlt disp 0))))
......
...@@ -8,23 +8,23 @@ ...@@ -8,23 +8,23 @@
;;; Also tested by make-array.lsp ;;; Also tested by make-array.lsp
(deftest arrayp.1 (deftest arrayp.1
(notnot (arrayp #(a b c))) (notnot-mv (arrayp #(a b c)))
t) t)
(deftest arrayp.2 (deftest arrayp.2
(notnot (arrayp "abcd")) (notnot-mv (arrayp "abcd"))
t) t)
(deftest arrayp.3 (deftest arrayp.3
(notnot (arrayp #*001110101)) (notnot-mv (arrayp #*001110101))
t) t)
(deftest arrayp.4 (deftest arrayp.4
(notnot (arrayp #0aNIL)) (notnot-mv (arrayp #0aNIL))
t) t)
(deftest arrayp.5 (deftest arrayp.5
(notnot (arrayp #2a((1 2 3)(4 5 6)))) (notnot-mv (arrayp #2a((1 2 3)(4 5 6))))
t) t)
(deftest arrayp.6 (deftest arrayp.6
......
...@@ -28,15 +28,15 @@ ...@@ -28,15 +28,15 @@
;;; See other tests in cl-symbols.lsp ;;; See other tests in cl-symbols.lsp
(deftest boundp.1 (deftest boundp.1
(notnot (boundp 't)) (notnot-mv (boundp 't))
t) t)
(deftest boundp.2 (deftest boundp.2
(notnot (boundp nil)) (notnot-mv (boundp nil))
t) t)
(deftest boundp.3 (deftest boundp.3
(notnot (boundp :foo)) (notnot-mv (boundp :foo))
t) t)
(deftest boundp.4 (deftest boundp.4
......
...@@ -6,12 +6,12 @@ ...@@ -6,12 +6,12 @@
(in-package :cl-test) (in-package :cl-test)
(deftest call-arguments-limit.1 (deftest call-arguments-limit.1
(not (constantp 'call-arguments-limit)) (notnot-mv (constantp 'call-arguments-limit))
nil) t)
(deftest call-arguments-limit.2 (deftest call-arguments-limit.2
(not (typep call-arguments-limit 'integer)) (notnot-mv (typep call-arguments-limit 'integer))
nil) t)
(deftest call-arguments-limit.3 (deftest call-arguments-limit.3
(< call-arguments-limit 50) (< call-arguments-limit 50)
......
...@@ -78,11 +78,11 @@ ...@@ -78,11 +78,11 @@
t) t)
(deftest char<=.7 (deftest char<=.7
(or (char<= #\9 #\A) (char<= #\Z #\0) t) (notnot-mv (or (char<= #\9 #\A) (char<= #\Z #\0)))
t) t)
(deftest char<=.8 (deftest char<=.8
(or (char<= #\9 #\a) (char<= #\z #\0) t) (notnot-mv (or (char<= #\9 #\a) (char<= #\z #\0)))
t) t)
(deftest char<.1 (deftest char<.1
...@@ -111,11 +111,11 @@ ...@@ -111,11 +111,11 @@
t) t)
(deftest char<.7 (deftest char<.7
(or (char< #\9 #\A) (char< #\Z #\0) t) (notnot-mv (or (char< #\9 #\A) (char< #\Z #\0)))
t) t)
(deftest char<.8 (deftest char<.8
(or (char< #\9 #\a) (char< #\z #\0) t) (notnot-mv (or (char< #\9 #\a) (char< #\z #\0)))
t) t)
...@@ -145,11 +145,11 @@ ...@@ -145,11 +145,11 @@
t) t)
(deftest char>=.7 (deftest char>=.7
(or (char>= #\A #\9) (char>= #\0 #\Z) t) (notnot-mv (or (char>= #\A #\9) (char>= #\0 #\Z)))
t) t)
(deftest char>=.8 (deftest char>=.8
(or (char>= #\a #\9) (char>= #\0 #\z) t) (notnot-mv (or (char>= #\a #\9) (char>= #\0 #\z)))
t) t)
(deftest char>.1 (deftest char>.1
...@@ -178,11 +178,11 @@ ...@@ -178,11 +178,11 @@
t) t)
(deftest char>.7 (deftest char>.7
(or (char> #\A #\9) (char> #\0 #\Z) t) (notnot-mv (or (char> #\A #\9) (char> #\0 #\Z)))
t) t)
(deftest char>.8 (deftest char>.8
(or (char> #\a #\9) (char> #\0 #\z) t) (notnot-mv (or (char> #\a #\9) (char> #\0 #\z)))
t) t)
;;; Case-insensitive comparisons ;;; Case-insensitive comparisons
...@@ -262,11 +262,11 @@ ...@@ -262,11 +262,11 @@
t) t)
(deftest char-not-greaterp.7 (deftest char-not-greaterp.7
(or (char-not-greaterp #\9 #\A) (char-not-greaterp #\Z #\0) t) (notnot-mv (or (char-not-greaterp #\9 #\A) (char-not-greaterp #\Z #\0)))
t) t)
(deftest char-not-greaterp.8 (deftest char-not-greaterp.8
(or (char-not-greaterp #\9 #\a) (char-not-greaterp #\z #\0) t) (notnot-mv (or (char-not-greaterp #\9 #\a) (char-not-greaterp #\z #\0)))
t) t)
(deftest char-lessp.1 (deftest char-lessp.1
...@@ -295,11 +295,11 @@ ...@@ -295,11 +295,11 @@
t) t)
(deftest char-lessp.7 (deftest char-lessp.7
(or (char-lessp #\9 #\A) (char-lessp #\Z #\0) t) (notnot-mv (or (char-lessp #\9 #\A) (char-lessp #\Z #\0)))
t) t)
(deftest char-lessp.8 (deftest char-lessp.8
(or (char-lessp #\9 #\a) (char-lessp #\z #\0) t) (notnot-mv (or (char-lessp #\9 #\a) (char-lessp #\z #\0)))
t) t)
(deftest char-not-lessp.1 (deftest char-not-lessp.1
...@@ -329,11 +329,11 @@ ...@@ -329,11 +329,11 @@
t) t)
(deftest char-not-lessp.7 (deftest char-not-lessp.7
(or (char-not-lessp #\A #\9) (char-not-lessp #\0 #\Z) t) (notnot-mv (or (char-not-lessp #\A #\9) (char-not-lessp #\0 #\Z)))
t) t)
(deftest char-not-lessp.8 (deftest char-not-lessp.8
(or (char-not-lessp #\a #\9) (char-not-lessp #\0 #\z) t) (notnot-mv (or (char-not-lessp #\a #\9) (char-not-lessp #\0 #\z)))
t) t)
(deftest char-greaterp.1 (deftest char-greaterp.1
...@@ -363,9 +363,9 @@ ...@@ -363,9 +363,9 @@
t) t)
(deftest char-greaterp.7 (deftest char-greaterp.7
(or (char-greaterp #\A #\9) (char-greaterp #\0 #\Z) t) (notnot-mv (or (char-greaterp #\A #\9) (char-greaterp #\0 #\Z)))
t) t)
(deftest char-greaterp.8 (deftest char-greaterp.8
(or (char-greaterp #\a #\9) (char-greaterp #\0 #\z) t) (notnot-mv (or (char-greaterp #\a #\9) (char-greaterp #\0 #\z)))
t) t)
...@@ -1065,16 +1065,16 @@ ...@@ -1065,16 +1065,16 @@
(deftest keywordp-1 (keywordp 'hefalump) nil) (deftest keywordp-1 (keywordp 'hefalump) nil)
(deftest keywordp-2 (keywordp 17) nil) (deftest keywordp-2 (keywordp 17) nil)
(deftest keywordp-3 (not (not (keywordp :stream))) t) (deftest keywordp-3 (notnot-mv (keywordp :stream)) t)
(deftest keywordp-4 (not (not (keywordp ':stream))) t) (deftest keywordp-4 (notnot-mv (keywordp ':stream)) t)
(deftest keywordp-5 (keywordp nil) nil) (deftest keywordp-5 (keywordp nil) nil)
(deftest keywordp-6 (not (not (keywordp :nil))) t) (deftest keywordp-6 (notnot-mv (keywordp :nil)) t)
(deftest keywordp-7 (keywordp '(:stream)) nil) (deftest keywordp-7 (keywordp '(:stream)) nil)
(deftest keywordp-8 (keywordp "rest") nil) (deftest keywordp-8 (keywordp "rest") nil)
(deftest keywordp-9 (keywordp ":rest") nil) (deftest keywordp-9 (keywordp ":rest") nil)
(deftest keywordp-10 (keywordp '&body) nil) (deftest keywordp-10 (keywordp '&body) nil)
;;; This next test was busted. ::foo is not portable syntax ;;; This next test was busted. ::foo is not portable syntax
;;(deftest keywordp-11 (not (not (keywordp ::foo))) t) ;;(deftest keywordp-11 (notnot-mv (keywordp ::foo)) t)
(deftest keywordp-12 (keywordp t) nil) (deftest keywordp-12 (keywordp t) nil)
(deftest keywordp-13 (classify-error (keywordp)) program-error) (deftest keywordp-13 (classify-error (keywordp)) program-error)
(deftest keywordp-14 (classify-error (keywordp :x :x)) program-error) (deftest keywordp-14 (classify-error (keywordp :x :x)) program-error)
...@@ -1122,7 +1122,7 @@ ...@@ -1122,7 +1122,7 @@
;;; make-symbol ;;; make-symbol
(deftest make-symbol-1 (deftest make-symbol-1
(not (not (symbolp (make-symbol "FOO")))) (notnot-mv (symbolp (make-symbol "FOO")))
t) t)
(deftest make-symbol-2 (deftest make-symbol-2
...@@ -1206,71 +1206,67 @@ ...@@ -1206,71 +1206,67 @@
;;; copy-symbol ;;; copy-symbol
(deftest copy-symbol-1 (deftest copy-symbol-1
(not (not (notnot-mv
(every (every
#'(lambda (x) #'(lambda (x)
(let ((y (copy-symbol x))) (let ((y (copy-symbol x)))
(and (null (symbol-plist y)) (and (null (symbol-plist y))
(symbolp y) (symbolp y)
(not (boundp y)) (not (boundp y))
(not (fboundp y)) (not (fboundp y))
(null (symbol-package y)) (null (symbol-package y))
(string= (symbol-name x) (symbol-name y)) (string= (symbol-name x) (symbol-name y))
(symbolp (copy-symbol y)) (symbolp (copy-symbol y))
))) )))
'(nil t a b |a| |123|)))) '(nil t a b |a| |123|)))
t) t)
(deftest copy-symbol-2 (deftest copy-symbol-2
(handler-case (progn
(progn (setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-plist '|foo|) '(a b c d)) (makunbound '|foo|)
(makunbound '|foo|) (notnot-mv
(not (not (every
(every #'(lambda (x)
#'(lambda (x) (let ((y (copy-symbol x t)))
(let ((y (copy-symbol x t))) (and
(and (equal (symbol-plist y) (symbol-plist x))
(equal (symbol-plist y) (symbol-plist x)) (symbolp y)
(symbolp y) (if (boundp x)
(if (boundp x) (boundp y)
(boundp y) (not (boundp y)))
(not (boundp y))) (not (fboundp y))
(not (fboundp y)) (null (symbol-package y))
(null (symbol-package y)) (string= (symbol-name x) (symbol-name y))
(string= (symbol-name x) (symbol-name y)) )))
))) '(nil t a b |foo| |a| |123|))))
'(nil t a b |foo| |a| |123|)))))
(error (c) c))
t) t)
(deftest copy-symbol-3 (deftest copy-symbol-3
(handler-case (progn
(progn (setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-plist '|foo|) '(a b c d)) (setf (symbol-value '|a|) 12345)
(setf (symbol-value '|a|) 12345) (notnot-mv
(not (not (every
(every #'(lambda (x)
#'(lambda (x) (let ((y (copy-symbol x t)))
(let ((y (copy-symbol x t))) (and
(and (eql (length (symbol-plist y))
(eql (length (symbol-plist y)) (length (symbol-plist x)))
(length (symbol-plist x))) ;; Is a list copy
;; Is a list copy (every #'eq (symbol-plist y) (symbol-plist x))
(every #'eq (symbol-plist y) (symbol-plist x)) (symbolp y)
(symbolp y) (if (boundp x)
(if (boundp x) (eqt (symbol-value x)
(eqt (symbol-value x) (symbol-value y))
(symbol-value y)) (not (boundp y)))
(not (boundp y))) (not (fboundp y))
(not (fboundp y)) (null (symbol-package y))
(null (symbol-package y)) (string= (symbol-name x) (symbol-name y))
(string= (symbol-name x) (symbol-name y)) (eql (length (symbol-plist x))
(eql (length (symbol-plist x)) (length (symbol-plist y)))
(length (symbol-plist y))) )))
))) '(nil t a b |foo| |a| |123|))))
'(nil t a b |foo| |a| |123|)))))
(error (c) c))
t) t)
(deftest copy-symbol-4 (deftest copy-symbol-4
......
...@@ -8,27 +8,27 @@ ...@@ -8,27 +8,27 @@
;;; More tests of type vector in make-array.lsp ;;; More tests of type vector in make-array.lsp
(deftest vector.type.1 (deftest vector.type.1
(notnot (typep #(a b c) 'vector)) (notnot-mv (typep #(a b c) 'vector))
t) t)
(deftest vector.type.2 (deftest vector.type.2
(notnot (typep #() 'vector)) (notnot-mv (typep #() 'vector))
t) t)
(deftest vector.type.3 (deftest vector.type.3
(notnot (typep "" 'vector)) (notnot-mv (typep "" 'vector))
t) t)
(deftest vector.type.4 (deftest vector.type.4
(notnot (typep "abcdef" 'vector)) (notnot-mv (typep "abcdef" 'vector))
t) t)
(deftest vector.type.5 (deftest vector.type.5
(notnot (typep #* 'vector)) (notnot-mv (typep #* 'vector))
t) t)
(deftest vector.type.6 (deftest vector.type.6
(notnot (typep #*011011101011 'vector)) (notnot-mv (typep #*011011101011 'vector))
t) t)
(deftest vector.type.7 (deftest vector.type.7
...@@ -44,15 +44,15 @@ ...@@ -44,15 +44,15 @@
t t) t t)
(deftest vector.type.10 (deftest vector.type.10
(notnot (typep #(a b c) '(vector *))) (notnot-mv (typep #(a b c) '(vector *)))
t) t)
(deftest vector.type.11 (deftest vector.type.11
(notnot (typep #(a b c) '(vector t))) (notnot-mv (typep #(a b c) '(vector t)))
t) t)
(deftest vector.type.12 (deftest vector.type.12
(notnot (typep "abcde" '(vector *))) (notnot-mv (typep "abcde" '(vector *)))
t) t)
(deftest vector.type.13 (deftest vector.type.13
...@@ -60,12 +60,69 @@ ...@@ -60,12 +60,69 @@
nil) nil)
(deftest vector.type.14 (deftest vector.type.14
(notnot (typep #*00110 '(vector *))) (notnot-mv (typep #*00110 '(vector *)))
t) t)
(deftest vector.type.15 (deftest vector.type.15
(typep #*00110 '(vector t)) (typep #*00110 '(vector t))
nil) nil)
(deftest vector.type.16
(notnot-mv (typep #(a b c) '(vector * 3)))
t)
(deftest vector.type.17
(typep #(a b c) '(vector * 2))
nil)
(deftest vector.type.18
(typep #(a b c) '(vector * 4))
nil)
(deftest vector.type.19
(notnot-mv (typep #(a b c) '(vector t 3)))
t)
(deftest vector.type.20
(typep #(a b c) '(vector t 2))
nil)
(deftest vector.type.21
(typep #(a b c) '(vector t 4))
nil)
(deftest vector.type.23
(notnot-mv (typep #(a b c) '(vector t *)))
nil)
(deftest vector.type.23a
(notnot-mv (typep "abcde" '(vector * 5)))
t)
(deftest vector.type.24
(typep "abcde" '(vector * 4))
nil)
(deftest vector.type.25
(typep "abcde" '(vector * 6))
nil)
(deftest vector.type.26
(notnot-mv (typep "abcde" '(vector * *)))
t)
(deftest vector.type.27
(typep "abcde" '(vector t 5))
nil)
(deftest vector.type.28
(typep "abcde" '(vector t 4))
nil)
(deftest vector.type.29
(typep "abcde" '(vector t 6))
nil)
(deftest vector.type.30