1 ;;;; miscellaneous side-effectful tests of CLOS and file-compiler
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; While most of SBCL is derived from the CMU CL system, the test
8 ;;;; files (like this one) were written from scratch after the fork
11 ;;;; This software is in the public domain and is provided with
12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
13 ;;;; more information.
15 ;;; Fix due to pmai, ported from CMUCL, regarding
16 ;;; MAKE-INSTANCES-OBSOLETE:
18 ((test :initarg :test)))
21 (let ((x (make-instance 'mio-test :test 42)))
22 (incf (slot-value x 'test))))
26 (make-instances-obsolete 'mio-test)
31 ;;; Some tests of bits of optimized MAKE-INSTANCE that were hopelessly
32 ;;; wrong until Gerd's ctor MAKE-INSTANCE optimization was ported.
33 (defvar *d-i-s-e-count* 0)
34 (defclass default-initargs-side-effect ()
36 (:default-initargs :x (incf *d-i-s-e-count*)))
37 (defun default-initargs-side-effect ()
38 (make-instance 'default-initargs-side-effect))
39 (assert (= *d-i-s-e-count* 0))
40 (default-initargs-side-effect)
41 (assert (= *d-i-s-e-count* 1))
42 (make-instance 'default-initargs-side-effect)
43 (assert (= *d-i-s-e-count* 2))
44 (make-instance 'default-initargs-side-effect :x 3)
45 (assert (= *d-i-s-e-count* 2))
47 (defclass class-allocation ()
48 ((x :allocation :class :initarg :x :initform 3)))
49 (defun class-allocation-reader ()
50 (slot-value (make-instance 'class-allocation) 'x))
51 (defun class-allocation-writer (value)
52 (setf (slot-value (make-instance 'class-allocation) 'x) value))
53 (assert (= (class-allocation-reader) 3))
54 (class-allocation-writer 4)
55 (assert (= (class-allocation-reader) 4))
58 (sb-ext:quit :unix-status 104)