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 @@
(deftest array-displacement.7
(let* ((a (make-array '(10)))
(b (make-array '(10) :displaced-to a)))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 0))))
......@@ -28,7 +28,7 @@
(deftest array-displacement.8
(let* ((a (make-array '(10)))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2)))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 2))))
......@@ -38,7 +38,7 @@
(let* ((a (make-array '(10) :element-type 'base-char))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2
:element-type 'base-char)))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 2))))
......@@ -48,7 +48,7 @@
(let* ((a (make-array '(10) :element-type 'base-char))
(b (make-array '(5) :displaced-to a
:element-type 'base-char)))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 0))))
......@@ -58,7 +58,7 @@
(let* ((a (make-array '(10) :element-type 'bit))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2
:element-type 'bit)))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 2))))
......@@ -68,7 +68,7 @@
(let* ((a (make-array '(10) :element-type 'bit))
(b (make-array '(5) :displaced-to a
:element-type 'bit)))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 0))))
......@@ -78,7 +78,7 @@
(let* ((a (make-array '(10) :element-type '(integer 0 255)))
(b (make-array '(5) :displaced-to a :displaced-index-offset 2
:element-type '(integer 0 255))))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 2))))
......@@ -88,7 +88,7 @@
(let* ((a (make-array '(10) :element-type '(integer 0 255)))
(b (make-array '(5) :displaced-to a
:element-type '(integer 0 255))))
(multiple-value-bind (dt disp)
(multiple-value-bind* (dt disp)
(array-displacement b)
(and (eqt a dt)
(eqlt disp 0))))
......
......@@ -8,23 +8,23 @@
;;; Also tested by make-array.lsp
(deftest arrayp.1
(notnot (arrayp #(a b c)))
(notnot-mv (arrayp #(a b c)))
t)
(deftest arrayp.2
(notnot (arrayp "abcd"))
(notnot-mv (arrayp "abcd"))
t)
(deftest arrayp.3
(notnot (arrayp #*001110101))
(notnot-mv (arrayp #*001110101))
t)
(deftest arrayp.4
(notnot (arrayp #0aNIL))
(notnot-mv (arrayp #0aNIL))
t)
(deftest arrayp.5
(notnot (arrayp #2a((1 2 3)(4 5 6))))
(notnot-mv (arrayp #2a((1 2 3)(4 5 6))))
t)
(deftest arrayp.6
......
......@@ -28,15 +28,15 @@
;;; See other tests in cl-symbols.lsp
(deftest boundp.1
(notnot (boundp 't))
(notnot-mv (boundp 't))
t)
(deftest boundp.2
(notnot (boundp nil))
(notnot-mv (boundp nil))
t)
(deftest boundp.3
(notnot (boundp :foo))
(notnot-mv (boundp :foo))
t)
(deftest boundp.4
......
......@@ -6,12 +6,12 @@
(in-package :cl-test)
(deftest call-arguments-limit.1
(not (constantp 'call-arguments-limit))
nil)
(notnot-mv (constantp 'call-arguments-limit))
t)
(deftest call-arguments-limit.2
(not (typep call-arguments-limit 'integer))
nil)
(notnot-mv (typep call-arguments-limit 'integer))
t)
(deftest call-arguments-limit.3
(< call-arguments-limit 50)
......
......@@ -78,11 +78,11 @@
t)
(deftest char<=.7
(or (char<= #\9 #\A) (char<= #\Z #\0) t)
(notnot-mv (or (char<= #\9 #\A) (char<= #\Z #\0)))
t)
(deftest char<=.8
(or (char<= #\9 #\a) (char<= #\z #\0) t)
(notnot-mv (or (char<= #\9 #\a) (char<= #\z #\0)))
t)
(deftest char<.1
......@@ -111,11 +111,11 @@
t)
(deftest char<.7
(or (char< #\9 #\A) (char< #\Z #\0) t)
(notnot-mv (or (char< #\9 #\A) (char< #\Z #\0)))
t)
(deftest char<.8
(or (char< #\9 #\a) (char< #\z #\0) t)
(notnot-mv (or (char< #\9 #\a) (char< #\z #\0)))
t)
......@@ -145,11 +145,11 @@
t)
(deftest char>=.7
(or (char>= #\A #\9) (char>= #\0 #\Z) t)
(notnot-mv (or (char>= #\A #\9) (char>= #\0 #\Z)))
t)
(deftest char>=.8
(or (char>= #\a #\9) (char>= #\0 #\z) t)
(notnot-mv (or (char>= #\a #\9) (char>= #\0 #\z)))
t)
(deftest char>.1
......@@ -178,11 +178,11 @@
t)
(deftest char>.7
(or (char> #\A #\9) (char> #\0 #\Z) t)
(notnot-mv (or (char> #\A #\9) (char> #\0 #\Z)))
t)
(deftest char>.8
(or (char> #\a #\9) (char> #\0 #\z) t)
(notnot-mv (or (char> #\a #\9) (char> #\0 #\z)))
t)
;;; Case-insensitive comparisons
......@@ -262,11 +262,11 @@
t)
(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)
(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)
(deftest char-lessp.1
......@@ -295,11 +295,11 @@
t)
(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)
(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)
(deftest char-not-lessp.1
......@@ -329,11 +329,11 @@
t)
(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)
(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)
(deftest char-greaterp.1
......@@ -363,9 +363,9 @@
t)
(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)
(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)
......@@ -1065,16 +1065,16 @@
(deftest keywordp-1 (keywordp 'hefalump) nil)
(deftest keywordp-2 (keywordp 17) nil)
(deftest keywordp-3 (not (not (keywordp :stream))) t)
(deftest keywordp-4 (not (not (keywordp ':stream))) t)
(deftest keywordp-3 (notnot-mv (keywordp :stream)) t)
(deftest keywordp-4 (notnot-mv (keywordp ':stream)) t)
(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-8 (keywordp "rest") nil)
(deftest keywordp-9 (keywordp ":rest") nil)
(deftest keywordp-10 (keywordp '&body) nil)
;;; 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-13 (classify-error (keywordp)) program-error)
(deftest keywordp-14 (classify-error (keywordp :x :x)) program-error)
......@@ -1122,7 +1122,7 @@
;;; make-symbol
(deftest make-symbol-1
(not (not (symbolp (make-symbol "FOO"))))
(notnot-mv (symbolp (make-symbol "FOO")))
t)
(deftest make-symbol-2
......@@ -1206,71 +1206,67 @@
;;; copy-symbol
(deftest copy-symbol-1
(not (not
(every
#'(lambda (x)
(let ((y (copy-symbol x)))
(and (null (symbol-plist y))
(symbolp y)
(not (boundp y))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(symbolp (copy-symbol y))
)))
'(nil t a b |a| |123|))))
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x)))
(and (null (symbol-plist y))
(symbolp y)
(not (boundp y))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(symbolp (copy-symbol y))
)))
'(nil t a b |a| |123|)))
t)
(deftest copy-symbol-2
(handler-case
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(makunbound '|foo|)
(not (not
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(equal (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(boundp y)
(not (boundp y)))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
)))
'(nil t a b |foo| |a| |123|)))))
(error (c) c))
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(makunbound '|foo|)
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(equal (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(boundp y)
(not (boundp y)))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
)))
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol-3
(handler-case
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-value '|a|) 12345)
(not (not
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(eql (length (symbol-plist y))
(length (symbol-plist x)))
;; Is a list copy
(every #'eq (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(eqt (symbol-value x)
(symbol-value y))
(not (boundp y)))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(eql (length (symbol-plist x))
(length (symbol-plist y)))
)))
'(nil t a b |foo| |a| |123|)))))
(error (c) c))
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-value '|a|) 12345)
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(eql (length (symbol-plist y))
(length (symbol-plist x)))
;; Is a list copy
(every #'eq (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(eqt (symbol-value x)
(symbol-value y))
(not (boundp y)))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(eql (length (symbol-plist x))
(length (symbol-plist y)))
)))
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol-4
......
......@@ -8,27 +8,27 @@
;;; More tests of type vector in make-array.lsp
(deftest vector.type.1
(notnot (typep #(a b c) 'vector))
(notnot-mv (typep #(a b c) 'vector))
t)
(deftest vector.type.2
(notnot (typep #() 'vector))
(notnot-mv (typep #() 'vector))
t)
(deftest vector.type.3
(notnot (typep "" 'vector))
(notnot-mv (typep "" 'vector))
t)
(deftest vector.type.4
(notnot (typep "abcdef" 'vector))
(notnot-mv (typep "abcdef" 'vector))
t)
(deftest vector.type.5
(notnot (typep #* 'vector))
(notnot-mv (typep #* 'vector))
t)
(deftest vector.type.6
(notnot (typep #*011011101011 'vector))
(notnot-mv (typep #*011011101011 'vector))
t)
(deftest vector.type.7
......@@ -44,15 +44,15 @@
t t)
(deftest vector.type.10
(notnot (typep #(a b c) '(vector *)))
(notnot-mv (typep #(a b c) '(vector *)))
t)
(deftest vector.type.11
(notnot (typep #(a b c) '(vector t)))
(notnot-mv (typep #(a b c) '(vector t)))
t)
(deftest vector.type.12
(notnot (typep "abcde" '(vector *)))
(notnot-mv (typep "abcde" '(vector *)))
t)
(deftest vector.type.13
......@@ -60,12 +60,69 @@
nil)
(deftest vector.type.14
(notnot (typep #*00110 '(vector *)))
(notnot-mv (typep #*00110 '(vector *)))
t)
(deftest vector.type.15
(typep #*00110 '(vector t))
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
(typep "abcde" '(vector t *))
nil)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment