tests/inspect.impure.lisp

   1 ;;;; tests for the INSPECT function
   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 (load "assertoid.lisp")
  15 (load "test-util.lisp")
  16 (use-package "ASSERTOID")
  17 (use-package "TEST-UTIL")
  18
  19 (defun test-inspect (object control)
  20   (let* ((control (if (listp control)
  21                       (format nil "~{~A~%~}" control)
  22                       control))
  23          (*standard-input* (make-string-input-stream control))
  24          (output (make-string-output-stream))
  25          (*standard-output* output))
  26     (inspect object)
  27     (get-output-stream-string output)))
  28
  29 (defclass class-with-prototype-print-error ()
  30   ((will-be-unbound)))
  31
  32 (defmethod print-object ((object class-with-prototype-print-error) stream)
  33   (print-unreadable-object (object stream :type t)
  34     (princ (slot-value object 'will-be-unbound) stream)))
  35
  36 (with-test (:name (inspect :no-error print-object :lp-454682))
  37   (let ((class (find-class 'class-with-prototype-print-error)))
  38     (flet ((test ()
  39              (test-inspect class '("q"))))
  40       ;; Prototype may not be initialized at this point.
  41       (assert (search "PROTOTYPE: " (test)))
  42       ;; Force protocol initialization and test again.
  43       (sb-mop:class-prototype class)
  44       (assert (search "PROTOTYPE: " (test))))))