Commit 8039e427 authored by pfdietz's avatar pfdietz

Added tests for VECTOR type designators. Modified the functions SUBTYPEP*,...

Added tests for VECTOR type designators.  Modified the functions SUBTYPEP*, EQT, etc. to preserve the number of values being returned, to prevent certain kinds of bugs from being concealed.
parent bdcbeb73
......@@ -8,33 +8,32 @@
(declaim (optimize (safety 3)))
;;; A function for coercing truth values to BOOLEAN
(defun notnot (x) (not (not x)))
;;; Comparison functions that are like various builtins,
;;; but are guaranteed to return T for true.
(defun eqt (x y)
"Like EQ, but guaranteed to return T for true."
(if (eq x y) t nil))
(apply #'values (mapcar #'notnot (multiple-value-list (eq x y)))))
(defun eqlt (x y)
"Like EQL, but guaranteed to return T for true."
(if (eql x y) t nil))
(apply #'values (mapcar #'notnot (multiple-value-list (eql x y)))))
(defun equalt (x y)
"Like EQUAL, but guaranteed to return T for true."
(if (equal x y) t nil))
(apply #'values (mapcar #'notnot (multiple-value-list (equal x y)))))
(defun equalpt (x y)
"Like EQUALP, but guaranteed to return T for true."
(if (equalp x y) t nil))
(apply #'values (mapcar #'notnot (multiple-value-list (equalp x y)))))
(defun =t (x &rest args)
"Like =, but guaranteed to return T for true."
(if (apply #'= x args) t nil))
;;; A function for coercing truth values to BOOLEAN
(defun notnot (x) (not (not x)))
(apply #'values (mapcar #'notnot (multiple-value-list (apply #'= args)))))
(defun make-int-list (n)
(loop for i from 0 below n collect i))
......@@ -222,15 +221,14 @@ the condition to go uncaught if it cannot be classified."
count (not (eqt e (nth i x)))))
;;;
;;; The function SUBTYPEP returns two generalized booleans.
;;; This auxiliary function returns two booleans instead
;;; The function SUBTYPEP should return two generalized booleans.
;;; This auxiliary function returns booleans instead
;;; (which makes it easier to write tests).
;;;
(defun subtypep* (obj type)
(multiple-value-bind (result good)
(subtypep obj type)
(values (notnot result)
(notnot good))))
(apply #'values
(mapcar #'notnot
(multiple-value-list (subtypep obj type)))))
;;; (eval-when (load eval compile)
;;; (unless (fboundp 'complement)
......
......@@ -150,6 +150,7 @@
(load "simple-vector-p.lsp")
(load "svref.lsp")
(load "upgraded-array-element-type.lsp")
(load "vector.lsp")
;;; Tests of packages
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Jan 23 06:32:02 2003
;;;; Contains: Tests of VECTOR (type and function)
(in-package :cl-test)
;;; More tests of type vector in make-array.lsp
(deftest vector.type.1
(notnot (typep #(a b c) 'vector))
t)
(deftest vector.type.2
(notnot (typep #() 'vector))
t)
(deftest vector.type.3
(notnot (typep "" 'vector))
t)
(deftest vector.type.4
(notnot (typep "abcdef" 'vector))
t)
(deftest vector.type.5
(notnot (typep #* 'vector))
t)
(deftest vector.type.6
(notnot (typep #*011011101011 'vector))
t)
(deftest vector.type.7
(typep #0aNIL 'vector)
nil)
(deftest vector.type.8
(typep #2a((a b c d)) 'vector)
nil)
(deftest vector.type.9
(subtypep* 'vector 'array)
t t)
(deftest vector.type.10
(notnot (typep #(a b c) '(vector *)))
t)
(deftest vector.type.11
(notnot (typep #(a b c) '(vector t)))
t)
(deftest vector.type.12
(notnot (typep "abcde" '(vector *)))
t)
(deftest vector.type.13
(typep "abcdef" '(vector t))
nil)
(deftest vector.type.14
(notnot (typep #*00110 '(vector *)))
t)
(deftest vector.type.15
(typep #*00110 '(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