Commit a31821cd authored by pfdietz's avatar pfdietz

Begin adding tests of the objects (clos) section. Start with DEFCLASS error tests.

parent 761f480d
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Mar 24 03:40:24 2003
;;;; Contains: Auxiliary functions for testing CLOS
(in-package :cl-test)
(defun make-defclass-test-name (&rest args)
(intern (apply #'concatenate 'string (mapcar #'string args))
(find-package :cl-test)))
(defmacro defclass-with-tests
(&whole args
class-name superclasses slot-specifiers
&rest class-options)
(assert (typep class-name '(and (not null) symbol)))
(assert (listp superclasses))
(assert (every #'(lambda (x) (typep x '(and (not null) symbol)))
superclasses))
(assert (listp slot-specifiers))
(assert (every #'(lambda (s)
(or (symbolp s) (and (consp s) (symbolp (car s)))))
slot-specifiers))
(assert (every #'(lambda (x)
(and (consp x)
(member (car x) '(:default-initargs
:documentation
:metaclass))))
class-options))
(assert (eql (length class-options)
(length (remove-duplicates class-options))))
(let* ((default-initargs (second (assoc :default-initargs class-options)))
(metaclass (or (second (assoc :metaclass class-options))
'standard-class))
(doc (second (assoc :documentation class-options)))
)
`(progn
(eval-when (load eval compile)
(ignore-errors (defclass ,@args)))
(deftest ,(make-defclass-test-name class-name
"-IS-IN-ITS-METACLASS")
(notnot-mv (typep (find-class ',class-name) ',metaclass))
t)
,@(when (eq metaclass 'standard-class)
`((deftest ,(make-defclass-test-name class-name
"S-ARE-STANDARD-OBJECTS")
(subtypep* ,class-name 'standard-object)
t t)))
;;; More tests here
)))
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Mar 24 03:39:54 2003
;;;; Contains: Tests of DEFCLASS
(in-package :cl-test)
;;; Error tests (let's get them out of the way)
(deftest defclass.error.1
(classify-error
(defclass defclass-error-1 nil
(foo foo)))
program-error)
(deftest defclass.error.2
(classify-error
(defclass defclass-error-2 nil
(foo (foo))))
program-error)
(deftest defclass.error.3
(classify-error
(defclass defclass-error-3 nil
((foo :initarg f1))
(:default-initargs :f1 10 :f1 20)))
program-error)
(deftest defclass.error.4
(classify-error
(defclass defclass-error-4 nil
((foo :initform 10 :initform 20 :reader defclass-error-4/foo))))
program-error)
(deftest defclass.error.5
(classify-error
(defclass defclass-error-5 nil
((foo :initform 10 :initform 10 :reader defclass-error-5/foo))))
program-error)
(deftest defclass.error.6
(classify-error
(defclass defclass-error-6 nil
((foo :initarg f1 :type t :type t :reader defclass-error-6/foo))))
program-error)
(deftest defclass.error.7
(classify-error
(defclass defclass-error-7 nil
((foo :initarg f1 :documentation "x" :reader defclass-error-7/foo
:documentation "x"))))
program-error)
(deftest defclass.error.8
(classify-error
(defclass defclass-error-8 ()
((foo #:unknown-slot-option nil))))
program-error)
(deftest defclass.error.9
(classify-error
(defclass defclass-error-9 ()
(foo bar)
(#:unknown-class-option nil)))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Mar 24 03:39:09 2003
;;;; Contains: Loader for CLOS-related test files
(compile-and-load "defclass-aux.lsp")
(load "defclass.lsp")
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