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))