Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Karsten Poeck
ansi-test
Commits
e1371863
Commit
e1371863
authored
May 29, 2003
by
pfdietz
Browse files
Added tests of method documentation strings, and half of FIND-CLASS (as reader rather than settor.)
parent
f20efd36
Changes
3
Hide whitespace changes
Inline
Side-by-side
ansi-tests/defgeneric.lsp
View file @
e1371863
...
...
@@ -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))
ansi-tests/find-class.lsp
0 → 100644
View file @
e1371863
;-*- 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.
ansi-tests/load-objects.lsp
View file @
e1371863
...
...
@@ -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")
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment