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