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 (defclass super-funcallable-mixin ()
  18   ((abc :accessor abc :initarg :abc))
  19   (:metaclass sb-mop:funcallable-standard-class))
  20
  21 (defclass sub-generic-function1 (standard-generic-function
  22                                  super-funcallable-mixin) ()
  23   (:metaclass sb-mop:funcallable-standard-class))
  24
  25 (defclass sub-method1 (standard-method) ())
  26
  27 (defgeneric myfun1 (a b)
  28   (:generic-function-class sub-generic-function1)
  29   (:method-class sub-method1))
  30
  31 (defvar *count1* 0)
  32
  33 (defmethod myfun1 (a b)
  34   (incf *count1*))
  35
  36 (with-test (:name (:mop-13 1))
  37   (myfun1 2 3)
  38   (assert (= *count1* 1))
  39   (myfun1 t nil)
  40   (assert (= *count1* 2)))
  41
  42 (defmethod myfun1 ((a integer) (b integer))
  43   (incf *count1* 2))
  44
  45 (with-test (:name (:mop-13 2))
  46   (myfun1 2 3)
  47   (assert (= *count1* 4))
  48   (myfun1 t nil)
  49   (assert (= *count1* 5)))
  50
  51 ;;; Friendlier superclass order test case
  52 (defclass sub-generic-function2 (super-funcallable-mixin
  53                                  standard-generic-function) ()
  54   (:metaclass sb-mop:funcallable-standard-class))
  55
  56 (defclass sub-method2 (standard-method) ())
  57
  58 (defgeneric myfun2 (a b)
  59   (:generic-function-class sub-generic-function2)
  60   (:method-class sub-method2))
  61
  62 (defvar *count2* 0)
  63
  64 (defmethod myfun2 (a b)
  65   (incf *count2*))
  66
  67 (with-test (:name (:mop-13 3))
  68   (myfun2 2 3)
  69   (assert (= *count2* 1))
  70   (myfun2 t nil)
  71   (assert (= *count2* 2)))
  72
  73 (defmethod myfun2 ((a integer) (b integer))
  74   (incf *count2* 2))
  75
  76 (with-test (:name (:mop-13 4))
  77   (myfun2 2 3)
  78   (assert (= *count2* 4))
  79   (myfun2 t nil)
  80   (assert (= *count2* 5)))