Commit e1371863 authored by pfdietz's avatar pfdietz
Browse files

Added tests of method documentation strings, and half of FIND-CLASS (as reader rather than settor.)

parent f20efd36
......@@ -236,9 +236,17 @@
(and (stringp doc) (string=t doc "boo!"))))
(let ((doc (documentation fn 'function)))
(or (not doc)
(and (stringp doc) (string=t doc "boo!"))))))
(and (stringp doc) (string=t doc "boo!"))))
(setf (documentation fn t) "foo")
(let ((doc (documentation fn t)))
(or (not doc)
(and (stringp doc) (string=t doc "foo"))))
(setf (documentation fn 'function) "bar")
(let ((doc (documentation fn t)))
(or (not doc)
(and (stringp doc) (string=t doc "bar"))))))
t t #(a b c) #(d e f) t t)
t t #(a b c) #(d e f) t t "foo" t "bar" t)
(deftest defgeneric.3
(let ((fn (eval '(defgeneric defgeneric.fun.3 (x y)
......@@ -787,3 +795,22 @@
(funcall fn 10))
(10 :good))
(deftest defgeneric.35
(let ((fn (eval '(defgeneric defgeneric.fun.35 (x)
(:method ((x (eql 'a)))
(declare (optimize (speed 0)))
"FOO"
(declare (optimize (safety 3)))
x)))))
(values
(funcall fn 'a)
(let ((method (first (compute-applicable-methods fn '(a)))))
(and method
(let ((doc (documentation method t)))
(list
(or (null doc) (equalt doc "FOO"))
(setf (documentation method t) "BAR")
(let ((doc (documentation method t)))
(or (null doc) (equalt doc "BAR")))
))))))
a (t "BAR" t))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu May 29 07:15:06 2003
;;;; Contains: Tests of FIND-CLASS
;; find-class is also tested in numerous other places.
(in-package :cl-test)
(deftest find-class.1
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name) (find-class name))
collect name)
nil)
(deftest find-class.2
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name t) (find-class name))
collect name)
nil)
(deftest find-class.3
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name nil) (find-class name))
collect name)
nil)
(deftest find-class.4
(handler-case
(progn (eval '(find-class (gensym))) :bad)
(error () :good))
:good)
(deftest find-class.5
(handler-case
(progn (eval '(find-class (gensym) t)) :bad)
(error () :good))
:good)
(deftest find-class.6
(find-class (gensym) nil)
nil)
(deftest find-class.7
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name t nil) (find-class name))
collect name)
nil)
(deftest find-class.8
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name nil nil) (find-class name))
collect name)
nil)
(deftest find-class.9
(macrolet
((%m (&environment env)
(let ((result
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name nil env)
(find-class name))
collect name)))
`',result)))
(%m))
nil)
(deftest find-class.10
(macrolet
((%m (&environment env)
(let ((result
(loop for name in *cl-types-that-are-classes-symbols*
unless (eq (find-class name t env)
(find-class name))
collect name)))
`',result)))
(%m))
nil)
(deftest find-class.11
(handler-case
(progn (eval '(find-class (gensym) 'a nil)) :bad)
(error () :good))
:good)
(deftest find-class.12
(find-class (gensym) nil nil)
nil)
(deftest find-class.13
(macrolet
((%m (&environment env)
`',(find-class (gensym) nil env)))
(%m))
nil)
(deftest find-class.14
(handler-case
(progn
(eval '(macrolet
((%m (&environment env)
`',(find-class (gensym) 17 env)))
(%m)))
:bad)
(error () :good))
:good)
;;; Need tests of assignment to (FIND-CLASS ...)
;;; Add tests of:
;;; Setting class to itself
;;; Changing class to a different class
;;; Changing to NIL (and that the class object stays around)
;;; Check that find-class is affected by the assignment, and
;;; class-name is not.
......@@ -41,3 +41,5 @@
(load "defgeneric-method-combination-and.lsp")
(load "defgeneric-method-combination-or.lsp")
(load "defgeneric-method-combination-progn.lsp")
;; (load "defgeneric-method-combination-standard.lsp")
(load "find-class.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