Commit ce01293a authored by pfdietz's avatar pfdietz

Add some built-in class tests

parent 16d37bd4
......@@ -168,3 +168,24 @@
(,option nil))
program-error)))
t)
(deftest defclass.error.23
(loop for cl in *built-in-classes*
for name = (class-name cl)
unless (or (not name)
(handler-case
(progn (eval `(defclass ,(gensym) (,name))) nil)
(error (c) c)))
collect (list cl name))
nil)
(deftest defclass.error.24
(loop for cl in *built-in-classes*
for name = (class-name cl)
unless (or (not name)
(handler-case
(progn (eval `(defclass ,name ())))
(error (c) c)))
collect (list cl name))
nil)
......@@ -39,13 +39,9 @@
t)
(deftest make-instance.error.6
(let ((classes (remove-duplicates
(remove-if-not
#'(lambda (cl) (typep cl 'built-in-class))
(mapcar #'class-of *universe*)))))
(loop for cl in classes
unless (eval `(signals-error (make-instance ',cl) error))
collect cl))
(loop for cl in *built-in-classes*
unless (eval `(signals-error (make-instance ',cl) error))
collect cl)
nil)
;; Definitions of methods
......
......@@ -131,7 +131,7 @@
(deftest slot-value.error.5
(let ((built-in-class (find-class 'built-in-class))
(slot-name (gensym)))
(loop for e in *mini-universe*
(loop for e in *universe*
for class = (class-of e)
when (and (eq (class-of class) built-in-class)
(handler-case (progn (slot-value e slot-name) t)
......@@ -142,7 +142,7 @@
(deftest slot-value.error.6
(let ((built-in-class (find-class 'built-in-class))
(slot-name (gensym)))
(loop for e in *mini-universe*
(loop for e in *universe*
for class = (class-of e)
when (and (eq (class-of class) built-in-class)
(handler-case (setf (slot-value e slot-name) t)
......
......@@ -465,7 +465,8 @@
(macro-function 'cond)
#'meaningless-user-function-for-universe
#'meaningless-user-generic-function-for-universe
#'(lambda (x) x)))
#'(lambda (x) x)
(compile nil '(lambda (x) x))))
(defparameter *methods*
(list
......@@ -524,3 +525,10 @@
*methods*))
'(;;; Others to fill in gaps
1.2s0 1.3f0 1.5d0 1.8l0 3/5 10000000000000000000000))))
(defparameter *classes*
(remove-duplicates (mapcar #'class-of *universe*)))
(defparameter *built-in-classes*
(remove-if-not #'(lambda (x) (typep x 'built-in-class))
*classes*))
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