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

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

parent 761f480d
No related branches found
No related tags found
No related merge requests found
;-*- 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")
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