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 REINITIALIZE-INSTANCE on generic
17 (defclass my-generic-function
(standard-generic-function)
19 (:metaclass sb-mop
:funcallable-standard-class
))
22 (:method-combination list
)
23 (:method list
((x float
)) (* x x
))
24 (:method list
((x integer
)) (1+ x
))
25 (:method list
((x number
)) (expt x
2))
26 (:generic-function-class my-generic-function
))
28 (with-test (:name
(:mop-10
1))
29 (assert (equal (foo 3) '(4 9))))
31 (defmethod sb-mop:compute-discriminating-function
((gf my-generic-function
))
32 (let ((orig (call-next-method)))
34 (let ((orig-result (apply orig args
)))
35 (cons gf
(reverse orig-result
))))))
37 (with-test (:name
(:mop-10
2))
38 (assert (equal (foo 3) '(4 9)))
39 (reinitialize-instance #'foo
)
40 (assert (equal (foo 3) (cons #'foo
'(9 4)))))