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