Skip to content
Snippets Groups Projects
Commit 8039e427 authored by pfdietz's avatar pfdietz
Browse files

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
No related branches found
No related tags found
No related merge requests found
......@@ -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)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment