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

Add some built-in class tests

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