1 ;;;; miscellaneous side-effectful tests of the MOP
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 ;;; This file contains tests of UPDATE-DEPENDENT.
16 (defclass dependent-history
()
17 ((history :initarg
:history
:accessor history
)))
19 (defmethod sb-mop:update-dependent
((generic-function generic-function
)
20 (history dependent-history
)
22 (push args
(history history
)))
23 (defmethod sb-mop:update-dependent
((class class
)
24 (history dependent-history
)
26 (push (cons class args
) (history history
)))
28 (defvar *history
* (make-instance 'dependent-history
:history nil
))
31 (sb-mop:add-dependent
#'upd1
*history
*)
32 (defmethod upd1 ((x integer
)) x
)
34 (with-test (:name
(:mop-8
1))
35 (let ((last (car (history *history
*))))
36 (assert (eq (car last
) 'add-method
))
37 (assert (typep (cadr last
) 'standard-method
))))
41 (sb-mop:add-dependent
(find-class 'foo
) *history
*)
45 (with-test (:name
(:mop-8
2))
46 (let ((last (car (history *history
*))))
47 (assert (eq (car last
) (find-class 'foo
)))))