1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / mop-13.impure-cload.lisp
1 ;;;; miscellaneous side-effectful tests of the MOP
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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
8 ;;;; from CMU CL.
9 ;;;;
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.
13
14 ;;; this file attempts to test possible metacircularity issues arising
15 ;;; from adding slots to generic functions in odd places.
16
17 (defpackage "MOP-13"
18   (:use "CL" "SB-MOP"))
19
20 (in-package "MOP-13")
21
22 (defclass super-funcallable-mixin ()
23   ((abc :accessor abc :initarg :abc))
24   (:metaclass funcallable-standard-class))
25
26 (defclass sub-generic-function1 (standard-generic-function
27                                  super-funcallable-mixin) ()
28   (:metaclass funcallable-standard-class))
29
30 (defclass sub-method1 (standard-method) ())
31
32 (defgeneric myfun1 (a b)
33   (:generic-function-class sub-generic-function1)
34   (:method-class sub-method1))
35
36 (defvar *count1* 0)
37
38 (defmethod myfun1 (a b)
39   (incf *count1*))
40
41 (myfun1 2 3)
42 (assert (= *count1* 1))
43 (myfun1 t nil)
44 (assert (= *count1* 2))
45
46 (defmethod myfun1 ((a integer) (b integer))
47   (incf *count1* 2))
48
49 (myfun1 2 3)
50 (assert (= *count1* 4))
51 (myfun1 t nil)
52 (assert (= *count1* 5))
53
54 ;;; Friendlier superclass order test case
55 (defclass sub-generic-function2 (super-funcallable-mixin
56                                  standard-generic-function) ()
57   (:metaclass funcallable-standard-class))
58
59 (defclass sub-method2 (standard-method) ())
60
61 (defgeneric myfun2 (a b)
62   (:generic-function-class sub-generic-function2)
63   (:method-class sub-method2))
64
65 (defvar *count2* 0)
66
67 (defmethod myfun2 (a b)
68   (incf *count2*))
69
70 (myfun2 2 3)
71 (assert (= *count2* 1))
72 (myfun2 t nil)
73 (assert (= *count2* 2))
74
75 (defmethod myfun2 ((a integer) (b integer))
76   (incf *count2* 2))
77
78 (myfun2 2 3)
79 (assert (= *count2* 4))
80 (myfun2 t nil)
81 (assert (= *count2* 5))