Skip to content
Snippets Groups Projects
Commit 7a23cd5a authored by pfdietz's avatar pfdietz
Browse files

Added note objects and logic for disabling tests with disabled notes. Still...

Added note objects and logic for disabling tests with disabled notes.  Still need to add printing of note names when tests fail.  Changed eval-when to avoid annoying style warnings.
parent 683662bb
No related branches found
No related tags found
No related merge requests found
Showing
with 165 additions and 69 deletions
...@@ -12,3 +12,12 @@ Please tell me when you find incorrect test cases. ...@@ -12,3 +12,12 @@ Please tell me when you find incorrect test cases.
Paul Dietz Paul Dietz
dietz@dls.net dietz@dls.net
--------------------------------
(30 Jun 2003) I've decided to add metainformation to the tests,
in the form of :<attribute> <value> pairs after DEFTEST. Also,
I've added a DEFNOTE form to define note objects whose names
can be attached to properties of tests, to enable selective
disabling of classes of tests.
...@@ -91,7 +91,11 @@ Results: ~A~%" expected-number form n results)))) ...@@ -91,7 +91,11 @@ Results: ~A~%" expected-number form n results))))
(loop for i from 0 below n collect i)) (loop for i from 0 below n collect i))
(defun make-int-array (n &optional (fn #'make-array)) (defun make-int-array (n &optional (fn #'make-array))
(let ((a (funcall fn n))) (when (symbolp fn)
(assert (fboundp fn))
(setf fn (symbol-function (the symbol fn))))
(let ((a (funcall (the function fn) n)))
(declare (type (array * *) a))
(loop for i from 0 below n do (setf (aref a i) i)) (loop for i from 0 below n do (setf (aref a i) i))
a)) a))
...@@ -106,17 +110,19 @@ Results: ~A~%" expected-number form n results)))) ...@@ -106,17 +110,19 @@ Results: ~A~%" expected-number form n results))))
(equal (aref a1) (aref a2)) (equal (aref a1) (aref a2))
(let ((ad (array-dimensions a1))) (let ((ad (array-dimensions a1)))
(and (equal ad (array-dimensions a2)) (and (equal ad (array-dimensions a2))
(if (= (array-rank a1) 1) (locally
(let ((as (first ad))) (declare (type (array * *) a1 a2))
(loop (if (= (array-rank a1) 1)
for i from 0 below as (let ((as (first ad)))
always (equal (aref a1 i) (aref a2 i)))) (loop
(let ((as (array-total-size a1))) for i from 0 below as
(and (= as (array-total-size a2)) always (equal (aref a1 i) (aref a2 i))))
(loop (let ((as (array-total-size a1)))
for i from 0 below as (and (= as (array-total-size a2))
always (equal (row-major-aref a1 i) (loop
(row-major-aref a2 i))))))))))) for i from 0 below as
always (equal (row-major-aref a1 i)
(row-major-aref a2 i))))))))))))
;;; *universe* is defined elsewhere -- it is a list of various ;;; *universe* is defined elsewhere -- it is a list of various
;;; lisp objects used when stimulating things in various tests. ;;; lisp objects used when stimulating things in various tests.
...@@ -207,11 +213,17 @@ Results: ~A~%" expected-number form n results)))) ...@@ -207,11 +213,17 @@ Results: ~A~%" expected-number form n results))))
"Check that a predicate P is the same as #'(lambda (x) (typep x TYPE)) "Check that a predicate P is the same as #'(lambda (x) (typep x TYPE))
by applying both to all elements of *UNIVERSE*. Print message by applying both to all elements of *UNIVERSE*. Print message
when a mismatch is found, and return number of mistakes." when a mismatch is found, and return number of mistakes."
(when (symbolp p)
(assert (fboundp p))
(setf p (symbol-function p)))
(assert (typep p 'function))
(loop (loop
for x in *universe* count for x in *universe* count
(block failed (block failed
(let ((p1 (handler-case (let ((p1 (handler-case
(funcall P x) (funcall (the function p) x)
(error () (format t "(FUNCALL ~S ~S) failed~%" (error () (format t "(FUNCALL ~S ~S) failed~%"
P x) P x)
(return-from failed t)))) (return-from failed t))))
...@@ -376,8 +388,8 @@ the condition to go uncaught if it cannot be classified." ...@@ -376,8 +388,8 @@ the condition to go uncaught if it cannot be classified."
(defun compose (&rest fns) (defun compose (&rest fns)
(let ((rfns (reverse fns))) (let ((rfns (reverse fns)))
#'(lambda (x) (loop for f of-type function #'(lambda (x) (loop for f
in rfns do (setf x (funcall f x))) x))) in rfns do (setf x (funcall (the function f) x))) x)))
(defun evendigitp (c) (defun evendigitp (c)
(notnot (find c "02468"))) (notnot (find c "02468")))
...@@ -417,8 +429,9 @@ the condition to go uncaught if it cannot be classified." ...@@ -417,8 +429,9 @@ the condition to go uncaught if it cannot be classified."
(cons 'list args))) (cons 'list args)))
(defparameter +standard-chars+ (defparameter +standard-chars+
(coerce
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789~!@#$%^&*()_+|\\=-`{}[]:\";'<>?,./ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789~!@#$%^&*()_+|\\=-`{}[]:\";'<>?,./
") " 'simple-base-string))
(defparameter (defparameter
+base-chars+ #.(concatenate 'simple-base-string +base-chars+ #.(concatenate 'simple-base-string
...@@ -436,16 +449,21 @@ the condition to go uncaught if it cannot be classified." ...@@ -436,16 +449,21 @@ the condition to go uncaught if it cannot be classified."
(defparameter +upper-case-chars+ (subseq +alpha-chars+ 26 52)) (defparameter +upper-case-chars+ (subseq +alpha-chars+ 26 52))
(defparameter +alphanumeric-chars+ (subseq +standard-chars+ 0 62)) (defparameter +alphanumeric-chars+ (subseq +standard-chars+ 0 62))
(defparameter +digit-chars+ "0123456789") (defparameter +digit-chars+ "0123456789")
(defparameter +extended-digit-chars+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ") (defparameter +extended-digit-chars+ (coerce
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
'simple-base-string))
(declaim (type simple-base-string +alpha-chars+ +lower-case-chars+ (declaim (type simple-base-string +alpha-chars+ +lower-case-chars+
+upper-case-chars+ +alphanumeric-chars+)) +upper-case-chars+ +alphanumeric-chars+ +extended-digit-chars+
+standard-chars+))
(defparameter +code-chars+ (defparameter +code-chars+
(coerce (loop for i from 0 below 256 (coerce (loop for i from 0 below 256
for c = (code-char i) for c = (code-char i)
when c collect c) when c collect c)
'string)) 'simple-string))
(declaim (type simple-string +code-chars+))
(defparameter +rev-code-chars+ (reverse +code-chars+)) (defparameter +rev-code-chars+ (reverse +code-chars+))
...@@ -453,7 +471,7 @@ the condition to go uncaught if it cannot be classified." ...@@ -453,7 +471,7 @@ the condition to go uncaught if it cannot be classified."
(defun has-non-abort-restart (c) (defun has-non-abort-restart (c)
(throw 'handled (throw 'handled
(if (position 'abort (compute-restarts c) (if (position 'abort (the list (compute-restarts c))
:key #'restart-name :test-not #'eq) :key #'restart-name :test-not #'eq)
'success 'success
'fail))) 'fail)))
...@@ -1256,11 +1274,11 @@ the condition to go uncaught if it cannot be classified." ...@@ -1256,11 +1274,11 @@ the condition to go uncaught if it cannot be classified."
(classify-error* (elt x n))) (classify-error* (elt x n)))
(defmacro defstruct* (&body args) (defmacro defstruct* (&body args)
`(eval-when (load eval compile) `(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(handler-case (eval '(defstruct ,@args)) (handler-case (eval '(defstruct ,@args))
(serious-condition () nil)))) (serious-condition () nil))))
(defun sort-package-list (x) (defun sort-package-list (x)
(sort (copy-list x) (sort (copy-list x)
#'string< #'string<
......
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
(in-package :cl-test) (in-package :cl-test)
(defun is-ordered-by (seq fn) (defun is-ordered-by (seq fn)
(declare (type function fn))
(let ((n (length seq))) (let ((n (length seq)))
(loop for i from 0 below (1- n) (loop for i from 0 below (1- n)
for e = (elt seq i) for e = (elt seq i)
...@@ -14,21 +15,28 @@ ...@@ -14,21 +15,28 @@
always (funcall fn e (elt seq j)))))) always (funcall fn e (elt seq j))))))
(defun is-antisymmetrically-ordered-by (seq fn) (defun is-antisymmetrically-ordered-by (seq fn)
(declare (type function fn))
(and (is-ordered-by seq fn) (and (is-ordered-by seq fn)
(is-ordered-by (reverse seq) (complement fn)))) (is-ordered-by (reverse seq) (complement fn))))
(defun is-case-insensitive (fn) (defun is-case-insensitive (fn)
(loop for c across +code-chars+ (when (symbolp fn)
for c1 = (char-upcase c) (assert (fboundp fn))
for c2 = (if (eql c c1) (char-downcase c) c1) (setf fn (symbol-function fn)))
always (assert (typep fn 'function))
(loop for d across +code-chars+ (locally
for d1 = (char-upcase d) (declare (type function fn))
for d2 = (if (eql d d1) (char-downcase d) d1) (loop for c across +code-chars+
always (equiv (funcall fn c d) for c1 = (char-upcase c)
(funcall fn c2 d) for c2 = (if (eql c c1) (char-downcase c) c1)
(funcall fn c d2) always
(funcall fn c2 d2))))) (loop for d across +code-chars+
for d1 = (char-upcase d)
for d2 = (if (eql d d1) (char-downcase d) d1)
always (equiv (funcall fn c d)
(funcall fn c2 d)
(funcall fn c d2)
(funcall fn c2 d2))))))
(defun equiv (&rest args) (defun equiv (&rest args)
(declare (dynamic-extent args)) (declare (dynamic-extent args))
...@@ -40,9 +48,15 @@ ...@@ -40,9 +48,15 @@
;;; From character.lsp ;;; From character.lsp
(defun char-type-error-check (fn) (defun char-type-error-check (fn)
(loop for x in *universe* (when (symbolp fn)
always (or (characterp x) (assert (fboundp fn))
(eqt (catch-type-error (funcall fn x)) 'type-error)))) (setf fn (symbol-function fn)))
(assert (typep fn 'function))
(locally
(declare (type function fn))
(loop for x in *universe*
always (or (characterp x)
(eqt (catch-type-error (funcall fn x)) 'type-error)))))
(defun standard-char.5.body () (defun standard-char.5.body ()
(loop for i from 0 below (min 65536 char-code-limit) (loop for i from 0 below (min 65536 char-code-limit)
......
...@@ -1134,14 +1134,6 @@ ...@@ -1134,14 +1134,6 @@
;;; Various error cases for symbol-related functions ;;; Various error cases for symbol-related functions
(deftest symbolp.error.1
(classify-error (symbolp))
program-error)
(deftest symbolp.error.2
(classify-error (symbolp nil nil))
program-error)
(deftest symbol-function.error.1 (deftest symbol-function.error.1
(classify-error (symbol-function)) (classify-error (symbol-function))
program-error) program-error)
......
...@@ -8,8 +8,6 @@ ...@@ -8,8 +8,6 @@
;; #+gcl (:use defpackage) ;; #+gcl (:use defpackage)
(:nicknames) (:nicknames)
(:import-from "COMMON-LISP-USER" #:compile-and-load "==>") (:import-from "COMMON-LISP-USER" #:compile-and-load "==>")
(:export)) (:export #:random-from-seq #:random-case #:coin #:random-permute))
#+cmu (import 'cl::quit :cl-test) #+cmu (import 'cl::quit :cl-test)
...@@ -6,7 +6,8 @@ ...@@ -6,7 +6,8 @@
(when (eq excl:*current-case-mode* :case-sensitive-lower) (when (eq excl:*current-case-mode* :case-sensitive-lower)
(push :lower-case *features*))) (push :lower-case *features*)))
(eval-when (load eval compile) (eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(intern "==>" "CL-USER") (intern "==>" "CL-USER")
(unless (fboundp 'compile-file-pathname) (unless (fboundp 'compile-file-pathname)
(defun compile-file-pathname (pathname) (defun compile-file-pathname (pathname)
......
...@@ -167,7 +167,8 @@ ...@@ -167,7 +167,8 @@
`(progn `(progn
(declaim (special ,class-var-name)) (declaim (special ,class-var-name))
(eval-when (load eval compile) (eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors (setq ,class-var-name (defclass ,@(cdr args))))) (ignore-errors (setq ,class-var-name (defclass ,@(cdr args)))))
(deftest ,(make-defclass-test-name class-name "-DEFCLASS-RETURNS-CLASS") (deftest ,(make-defclass-test-name class-name "-DEFCLASS-RETURNS-CLASS")
......
...@@ -19,7 +19,8 @@ ...@@ -19,7 +19,8 @@
(dolist (parent parents) (assert (symbolp parent))) (dolist (parent parents) (assert (symbolp parent)))
(let ((name (symbol-name name-symbol))) (let ((name (symbol-name name-symbol)))
`(eval-when (load eval compile) `(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors (eval '(define-condition ,name-symbol ,parents (ignore-errors (eval '(define-condition ,name-symbol ,parents
,slot-specs ,@options))) ,slot-specs ,@options)))
,@(loop for parent in (adjoin 'condition parents) ,@(loop for parent in (adjoin 'condition parents)
......
...@@ -53,7 +53,8 @@ ...@@ -53,7 +53,8 @@
c c
(c b)) (c b))
(eval-when (load eval compile) (eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors (ignore-errors
(defun (setf defun-test-fun-4) (newval x) (defun (setf defun-test-fun-4) (newval x)
(return-from defun-test-fun-4 (setf (car x) newval))))) (return-from defun-test-fun-4 (setf (car x) newval)))))
...@@ -27,7 +27,8 @@ ...@@ -27,7 +27,8 @@
(not-mv (fboundp 'fboundp-5-fn)) (not-mv (fboundp 'fboundp-5-fn))
nil) nil)
(eval-when (eval compile) (eval-when #+gcl (eval compile)
#-gcl (:load-toplevel :compile-toplevel)
(ignore-errors (ignore-errors
(defun (setf fboundp-6-accessor) (y x) (setf (car x) y)))) (defun (setf fboundp-6-accessor) (y x) (setf (car x) y))))
......
...@@ -47,7 +47,8 @@ ...@@ -47,7 +47,8 @@
(typep '(lambda (x) x) 'function) (typep '(lambda (x) x) 'function)
nil) nil)
(eval-when (eval compile) (eval-when #+gcl (eval compile)
#-gcl (:load-toplevel :compile-toplevel)
(ignore-errors (ignore-errors
(defun (setf function-7-accessor) (y x) (setf (car x) y) y))) (defun (setf function-7-accessor) (y x) (setf (car x) y) y)))
......
...@@ -46,7 +46,8 @@ ...@@ -46,7 +46,8 @@
(functionp '(lambda (x) x)) (functionp '(lambda (x) x))
nil) nil)
(eval-when (eval compile) (eval-when #+gcl (eval compile)
#-gcl (:load-toplevel :compile-toplevel)
(ignore-errors (ignore-errors
(defun (setf functionp-7-accessor) (y x) (setf (car x) y) y))) (defun (setf functionp-7-accessor) (y x) (setf (car x) y) y)))
......
...@@ -93,6 +93,13 @@ ...@@ -93,6 +93,13 @@
*gensym-counter*) *gensym-counter*)
10) 10)
;;; GENSYM counter is a non-negative integer
(deftest gensym-counter.1
(and (integerp *gensym-counter*)
(>= *gensym-counter* 0)
t)
t)
;;; Check response to erroneous arguments ;;; Check response to erroneous arguments
;;; Note! NIL is not the same as no argument ;;; Note! NIL is not the same as no argument
;;; gensym should be implemented so that its only ;;; gensym should be implemented so that its only
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jun 22 09:32:09 2003
;;;; Contains: Tests of GENTEMP
(in-package :cl-test)
...@@ -2,10 +2,13 @@ ...@@ -2,10 +2,13 @@
(compile-and-load "cl-symbols-aux.lsp") (compile-and-load "cl-symbols-aux.lsp")
;; (load "cl-symbol-names.lsp") ;; moved to gclload1.lsp ;; (load "cl-symbol-names.lsp") ;; moved to gclload1.lsp
(load "cl-symbols.lsp") (load "cl-symbols.lsp")
(load "symbolp.lsp")
(load "boundp.lsp") (load "boundp.lsp")
(load "copy-symbol.lsp") (load "copy-symbol.lsp")
(load "gensym.lsp") (load "gensym.lsp")
(load "gentemp.lsp")
(load "keywordp.lsp") (load "keywordp.lsp")
(load "make-symbol.lsp") (load "make-symbol.lsp")
(load "symbol-name.lsp") (load "symbol-name.lsp")
(load "special-operator-p.lsp") (load "special-operator-p.lsp")
(load "set.lsp")
...@@ -4,8 +4,8 @@ ...@@ -4,8 +4,8 @@
;;;; Contains: Package definition for RT ;;;; Contains: Package definition for RT
(eval-when (eval-when
;;(:execute :compile-toplevel :load-toplevel) #-gcl (:execute :compile-toplevel :load-toplevel)
(load eval compile) #+gcl (load eval compile)
(defpackage :regression-test (defpackage :regression-test
(:use :cl) (:use :cl)
(:nicknames :rtest #-lispworks :rt) (:nicknames :rtest #-lispworks :rt)
...@@ -21,6 +21,7 @@ ...@@ -21,6 +21,7 @@
#:pending-tests #:pending-tests
#:rem-all-tests #:rem-all-tests
#:rem-test #:rem-test
#:defnote
))) )))
(in-package :regression-test) (in-package :regression-test)
...@@ -46,9 +46,23 @@ ...@@ -46,9 +46,23 @@
(defvar *expected-failures* nil (defvar *expected-failures* nil
"A list of test names that are expected to fail.") "A list of test names that are expected to fail.")
(defvar *notes* (make-hash-table :test 'equal)
"A mapping from names of notes to note objects.")
(defstruct (entry (:conc-name nil)) (defstruct (entry (:conc-name nil))
pend name props form vals) pend name props form vals)
;;; Note objects are used to attach information to tests.
;;; A typical use is to mark tests that depend on a particular
;;; part of a set of requirements, or a particular interpretation
;;; of the requirements.
(defstruct note
name
contents
disabled ;; When true, tests with this note are considered inactive
)
;; (defmacro vals (entry) `(cdddr ,entry)) ;; (defmacro vals (entry) `(cdddr ,entry))
(defmacro defn (entry) (defmacro defn (entry)
...@@ -87,6 +101,20 @@ ...@@ -87,6 +101,20 @@
name)) name))
entry)) entry))
(defun entry-notes (entry)
(let* ((props (props entry))
(notes (getf props :notes)))
(if (listp notes)
notes
(list notes))))
(defun has-disabled-note (entry)
(let ((notes (entry-notes entry)))
(loop for n in notes
for note = (if (note-p n) n
(gethash n *notes*))
thereis (and note (note-disabled note)))))
(defmacro deftest (name &rest body) (defmacro deftest (name &rest body)
(let* ((p body) (let* ((p body)
(properties (properties
...@@ -279,11 +307,11 @@ ...@@ -279,11 +307,11 @@
(defun do-entries (s) (defun do-entries (s)
(format s "~&Doing ~A pending test~:P ~ (format s "~&Doing ~A pending test~:P ~
of ~A tests total.~%" of ~A tests total.~%"
(count t (cdr *entries*) (count t (the list (cdr *entries*)) :key #'pend)
:key #'pend)
(length (cdr *entries*))) (length (cdr *entries*)))
(dolist (entry (cdr *entries*)) (dolist (entry (cdr *entries*))
(when (pend entry) (when (and (pend entry)
(not (has-disabled-note entry)))
(format s "~@[~<~%~:; ~:@(~S~)~>~]" (format s "~@[~<~%~:; ~:@(~S~)~>~]"
(do-entry entry s)))) (do-entry entry s))))
(let ((pending (pending-tests)) (let ((pending (pending-tests))
...@@ -314,3 +342,12 @@ ...@@ -314,3 +342,12 @@
new-failures))) new-failures)))
)) ))
(null pending)))) (null pending))))
;;; Note handling functions and macros
(defmacro defnote (name contents)
`(eval-when #+gcl (load eval) #-gcl (:load-toplevel :execute)
(let ((note (make-note :name ,name :contents ,contents)))
(setf (gethash *notes* (note-name note)) note)
note)))
...@@ -263,7 +263,8 @@ do the defstruct." ...@@ -263,7 +263,8 @@ do the defstruct."
(cons slot-name (defstruct-maketemp name "SLOTTEMP" i))))) (cons slot-name (defstruct-maketemp name "SLOTTEMP" i)))))
) )
;; Build the tests in an eval-when form ;; Build the tests in an eval-when form
`(eval-when (compile load eval) `(eval-when #+gcl (compile load eval)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors (ignore-errors
(eval '(defstruct ,name-and-options (eval '(defstruct ,name-and-options
......
...@@ -376,7 +376,8 @@ ...@@ -376,7 +376,8 @@
;;; Initializer forms are evaluated only when needed, and are ;;; Initializer forms are evaluated only when needed, and are
;;; evaluated in the lexical environment in which they were defined ;;; evaluated in the lexical environment in which they were defined
(eval-when (load eval) (eval-when #+gcl (load eval)
#-gcl (:load-toplevel)
(let ((x nil)) (let ((x nil))
(flet ((%f () x) (flet ((%f () x)
(%g (y) (setf x y))) (%g (y) (setf x y)))
......
...@@ -98,11 +98,11 @@ ...@@ -98,11 +98,11 @@
;;;; Tests on the definitions of various vector types ;;;; Tests on the definitions of various vector types
(deftest string-is-vector-of-character.1 (deftest string-is-not-vector-of-character.1
(subtypep* 'string '(vector character)) (subtypep* 'string '(vector character))
t t) nil t)
(deftest string-is-vector-of-character.2 (deftest vector-of-character-is-string.2
(subtypep* '(vector character) 'string) (subtypep* '(vector character) 'string)
t t) t t)
...@@ -110,7 +110,7 @@ ...@@ -110,7 +110,7 @@
(subtypep* '(string *) '(vector character)) (subtypep* '(string *) '(vector character))
nil t) nil t)
(deftest string-is-vector-of-character.4 (deftest vector-of-character-is-string.4
(subtypep* '(vector character) '(string *)) (subtypep* '(vector character) '(string *))
t t) t t)
...@@ -118,7 +118,7 @@ ...@@ -118,7 +118,7 @@
(subtypep* '(string 17) '(vector character 17)) (subtypep* '(string 17) '(vector character 17))
nil t) nil t)
(deftest string-is-vector-of-character.6 (deftest vector-of-character-is-string.6
(subtypep* '(vector character 17) '(string 17)) (subtypep* '(vector character 17) '(string 17))
t t) t t)
...@@ -174,7 +174,7 @@ ...@@ -174,7 +174,7 @@
(subtypep* 'simple-string '(simple-array character (*))) (subtypep* 'simple-string '(simple-array character (*)))
nil t) nil t)
(deftest simple-string-is-simple-1d-array-of-character.2 (deftest simple-1d-array-of-character-is-simple-string.2
(subtypep* '(simple-array character (*)) 'simple-string) (subtypep* '(simple-array character (*)) 'simple-string)
t t) t t)
...@@ -182,7 +182,7 @@ ...@@ -182,7 +182,7 @@
(subtypep* '(simple-string *) '(simple-array character (*))) (subtypep* '(simple-string *) '(simple-array character (*)))
nil t) nil t)
(deftest simple-string-is-simple-1d-array-of-character.4 (deftest simple-1d-array-of-character-is-simple-string.4
(subtypep* '(simple-array character (*)) '(simple-string *)) (subtypep* '(simple-array character (*)) '(simple-string *))
t t) t t)
...@@ -190,7 +190,7 @@ ...@@ -190,7 +190,7 @@
(subtypep* '(simple-string 17) '(simple-array character (17))) (subtypep* '(simple-string 17) '(simple-array character (17)))
nil t) nil t)
(deftest simple-string-is-simple-1d-array-of-character.6 (deftest simple-1d-array-of-character-is-simple-string.6
(subtypep* '(simple-array character (17)) '(simple-string 17)) (subtypep* '(simple-array character (17)) '(simple-string 17))
t t) t t)
......
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