(load "assertoid.lisp")
(use-package "ASSERTOID")
+(use-package "TEST-UTIL")
(defmacro assert-nil-nil (expr)
`(assert (equal '(nil nil) (multiple-value-list ,expr))))
(mapcar #'find-class '(simple-condition
condition
sb-pcl::slot-object
- sb-kernel:instance
t))))
;; stream classes
'fundamental-stream))
(mapcar #'find-class '(fundamental-stream
standard-object
- sb-pcl::std-object
sb-pcl::slot-object
stream
- sb-kernel:instance
t))))
(assert (equal (sb-pcl:class-precedence-list (find-class
'fundamental-stream))
(mapcar #'find-class '(fundamental-stream
standard-object
- sb-pcl::std-object
sb-pcl::slot-object stream
- sb-kernel:instance t))))
+ t))))
(assert (subtypep (find-class 'stream) (find-class t)))
(assert (subtypep (find-class 'fundamental-stream) 'stream))
(assert (not (subtypep 'stream 'fundamental-stream)))))
(assert-t-t (subtypep `(not ,t2) `(not ,t1)))
(assert-nil-t (subtypep `(not ,t1) `(not ,t2))))
\f
+;;; not easily visible to user code, but this used to be very
+;;; confusing.
+(with-test (:name (:ctor :typep-function))
+ (assert (eval '(typep (sb-pcl::ensure-ctor
+ (list 'sb-pcl::ctor (gensym)) nil nil)
+ 'function))))
+(with-test (:name (:ctor :functionp))
+ (assert (functionp (sb-pcl::ensure-ctor
+ (list 'sb-pcl::ctor (gensym)) nil nil))))
+\f
+;;; from PFD ansi-tests
+(let ((t1 '(cons (cons (cons (real -744833699 -744833699) cons)
+ (integer -234496 215373))
+ integer))
+ (t2 '(cons (cons (cons integer integer)
+ (integer -234496 215373))
+ t)))
+ (assert (null (values (subtypep `(not ,t2) `(not ,t1))))))
+\f
;;; success