From e8e3ccee2ad4acb6ee1774d91648b68254868483 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 6 Oct 2004 12:56:14 +0000 Subject: [PATCH] 0.8.15.8: Fix for PRINT-LEVEL.8 and PRINT-LEVEL.9. ... ANSI makes the slightly bizarre requirement that while the slots of a structure are 'components' in the sense of *PRINT-LEVEL*, the type name isn't. So, printing a slotless struct does not involve descending a level. --- NEWS | 2 +- src/code/target-defstruct.lisp | 14 ++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index eec6df0..29cb051 100644 --- a/NEWS +++ b/NEWS @@ -14,7 +14,7 @@ changes in sbcl-0.8.16 relative to sbcl-0.8.15: * fixed some bugs revealed by Paul Dietz' test suite: ** POSITION on displaced vectors with non-zero displacement returns the right answer. - ** (SIGNED-BYTE) is a valid type specifier for sequence creators. + ** (SIMPLE-STRING) is a valid type specifier for sequence creators. changes in sbcl-0.8.15 relative to sbcl-0.8.14: * incompatible change: SB-INT:*BEFORE-SAVE-INITIALIZATIONS* and diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 4138741..267e58b 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -418,6 +418,15 @@ (write-char #\space stream) (write-string "(no LAYOUT-INFO)")) (return-from %default-structure-pretty-print nil)) + ;; the structure type doesn't count as a component for + ;; *PRINT-LEVEL* processing. We can likewise elide the logical + ;; block processing, since all we have to print is the type name. + ;; -- CSR, 2004-10-05 + (when (and dd (null (dd-slots dd))) + (write-string "#S(" stream) + (prin1 name stream) + (write-char #\) stream) + (return-from %default-structure-pretty-print nil)) (pprint-logical-block (stream nil :prefix "#S(" :suffix ")") (prin1 name stream) (let ((remaining-slots (dd-slots dd))) @@ -444,6 +453,11 @@ (let* ((layout (%instance-layout structure)) (name (classoid-name (layout-classoid layout))) (dd (layout-info layout))) + (when (and dd (null (dd-slots dd))) + (write-string "#S(" stream) + (prin1 name stream) + (write-char #\) stream) + (return-from %default-structure-ugly-print nil)) (descend-into (stream) (write-string "#S(" stream) (prin1 name stream) diff --git a/version.lisp-expr b/version.lisp-expr index bb153b6..740db47 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.15.7" +"0.8.15.8" -- 1.7.10.4