tests/condition.impure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (cl:in-package :cl-user)
  13
  14 ;;; Bug from CLOCC.
  15 (defpackage :p1
  16   (:use :cl)
  17   (:export #:code #:code-msg #:%code-msg))
  18 (in-package :p1)
  19 (define-condition code ()
  20   ((msg :reader code-msg :reader %code-msg :initarg :msg)))
  21
  22 (defpackage :p2
  23   (:use :cl :p1))
  24 (in-package :p2)
  25 (define-condition code1 (code)
  26   ((msg :accessor code-msg :initarg :msg)))
  27
  28 (let ((code (make-condition 'code :msg 1)))
  29   (assert (typep code 'code))
  30   (assert (eql (code-msg code) 1))
  31   (assert (eql (%code-msg code) 1)))
  32 (let ((code (make-condition 'code1 :msg 1)))
  33   (assert (typep code 'code))
  34   (assert (eql (code-msg code) 1))
  35   (assert (eql (%code-msg code) 1))
  36   (setf (code-msg code) 2)
  37   (assert (eql (code-msg code) 2))
  38   (assert (eql (%code-msg code) 1)))
  39
  40 ;;; success
  41 (sb-ext:quit :unix-status 104)