From b1b85bbf17f686a0787304a04cf0e01e8216d038 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 28 Oct 2004 14:29:12 +0000 Subject: [PATCH] 0.8.16.11: Partial fix for #318 & more incompatible changes * Robustify STYLE-WARNINGs and compiler messages against circular objects and other nasties. * In the process replace *COMPILER-ERROR-PRINT-FOO* with *COMPILER-PRINT-VARIABLE-ALIST*, remove support for already depracated *DEBUG-PRINT-FOO*s and move both printer control alists to SB-EXT. * Update the fine manual. --- BUGS | 17 +++-- NEWS | 9 +++ doc/manual/compiler.texinfo | 16 ++--- doc/manual/debugger.texinfo | 21 ++----- package-data-list.lisp-expr | 8 ++- src/code/debug.lisp | 133 ++++++++++++++++++---------------------- src/code/early-extensions.lisp | 14 +++++ src/code/error.lisp | 7 ++- src/compiler/ir1report.lisp | 55 +++++------------ src/compiler/macros.lisp | 26 ++++++++ tests/defstruct.impure.lisp | 11 ++++ version.lisp-expr | 2 +- 12 files changed, 168 insertions(+), 151 deletions(-) diff --git a/BUGS b/BUGS index 1f627e5..b6981d2 100644 --- a/BUGS +++ b/BUGS @@ -1217,15 +1217,20 @@ WORKAROUND: 318: "stack overflow in compiler warning with redefined class" reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP test suite. - (setq *print-pretty* nil) (defstruct foo a) (setf (find-class 'foo) nil) (defstruct foo slot-1) - gives - ...# + ... + debugger invoked on a TYPE-ERROR in thread 19973: + The value NIL is not of type FUNCTION. + + CSR notes: it's not really clear what it should give: is (SETF FIND-CLASS) + meant to be enough to delete structure classes from the system? 319: "backquote with comma inside array" reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP diff --git a/NEWS b/NEWS index c676d3c..b12970f 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,15 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16: * minor incompatible change: BASE-CHAR no longer names a class; however, CHARACTER continues to do so, as required by ANSI. + * minor incompatible change: SB-DEBUG:*DEBUG-PRINT-FOO* variables + are no longer supported, and SB-DEBUG:*DEBUG-PRINT-VARIABLE-ALIST* + has been moved to the SB-EXT package (temporarily re-exported from + SB-DEBUG). + * minor incompatible change: SB-C::*COMPILER-ERROR-PRINT-FOO* variables + are no longer supported: use SB-EXT:*COMPILER-PRINT-VARIABLE-ALIST* + instead. + * bug fix: Cyclic structures and unprintable objects in compiler + messages no longer cause errors. (reported by Bruno Haible) * bug fix: READ, READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST, and READ-FROM-STRING all now return a primary value of NIL if *READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL) diff --git a/doc/manual/compiler.texinfo b/doc/manual/compiler.texinfo index a8aab4f..f592415 100644 --- a/doc/manual/compiler.texinfo +++ b/doc/manual/compiler.texinfo @@ -77,6 +77,12 @@ Cancels the effect of a previous @code{sb-ext:muffle-condition} declaration. @end deffn +Various details of @emph{how} the compiler messages are printed can be +controlled via the alist +@code{sb-ext:*compiler-print-variable-alist*}. + +@include var-sb-ext-star-compiler-print-variable-alist-star.texinfo + @c - @node Diagnostic Severity @comment node-name, next, previous, up @subsection Diagnostic Severity diff --git a/doc/manual/debugger.texinfo b/doc/manual/debugger.texinfo index 6a9e137..0d018f9 100644 --- a/doc/manual/debugger.texinfo +++ b/doc/manual/debugger.texinfo @@ -140,21 +140,7 @@ current frame. For more information on debugger variable access, see In the debugger, it is possible to override the printing behaviour of the REPL. -@defvr {Variable} sb-debug:*debug-print-variable-alist* - -An association list describing new bindings for special variables -(typically *PRINT-FOO* variables) to be used within the debugger, e.g. -@lisp -((*PRINT-LENGTH* . 10) (*PRINT-LEVEL* . 6) (*PRINT-PRETTY* . NIL)) -@end lisp -The variables in the @code{car} position are bound to the values in -the @code{cdr} during the execution of some debug commands. When -evaluating arbitrary expressions in the debugger, the normal values of -the printer control variables are in effect. @c FIXME: is this correct? -@code{*debug-print-variable-alist*} does not contain any bindings -initially. - -@end defvr +@include var-sb-ext-star-debug-print-variable-alist-star.texinfo @node Stack Frames @comment node-name, next, previous, up @@ -1007,8 +993,9 @@ proceed cases. @end deffn @deffn {Debugger Command} backtrace [@var{n}] -Displays all the frames from the current to the bottom. Only shows -@var{n} frames if specified. The printing is controlled by @code{*debug-print-variable-alist*}. +Displays all the frames from the current to the bottom. Only shows +@var{n} frames if specified. The printing is controlled by +@code{*debug-print-variable-alist*}. @end deffn @deffn {Debugger Command} step diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 1d5e0f0..c04bdf1 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -365,10 +365,9 @@ basic stuff like BACKTRACE and ARG. For now, the actual supported interface is still mixed indiscriminately with low-level internal implementation stuff like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." :use ("CL" "SB!EXT" "SB!INT" "SB!SYS" "SB!KERNEL") + :reexport ("*DEBUG-PRINT-VARIABLE-ALIST*") :export ("*DEBUG-BEGINNER-HELP-P*" "*DEBUG-CONDITION*" - "*DEBUG-PRINT-LENGTH*" "*DEBUG-PRINT-LEVEL*" - "*DEBUG-PRINT-VARIABLE-ALIST*" "*DEBUG-READTABLE*" "*DEBUG-HELP-STRING*" "*FLUSH-DEBUG-ERRORS*" "*IN-THE-DEBUGGER*" "*TRACE-INDENTATION-STEP*" "*MAX-TRACE-INDENTATION*" @@ -555,6 +554,10 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "*GC-RUN-TIME*" "PURIFY" + ;; Customizing printing of compiler and debugger messages + "*COMPILER-PRINT-VARIABLE-ALIST*" + "*DEBUG-PRINT-VARIABLE-ALIST*" + ;; Hooks into init & save sequences "*INIT-HOOKS*" "*SAVE-HOOKS*" @@ -848,6 +851,7 @@ retained, possibly temporariliy, because it might be used internally." "BINDING*" "!DEF-BOOLEAN-ATTRIBUTE" "WITH-REBOUND-IO-SYNTAX" + "WITH-SANE-IO-SYNTAX" ;; ..and CONDITIONs.. "BUG" diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 54bd156..2b40aca 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -31,25 +31,20 @@ ;;; to satisfy lambda list ;;; #: ;;; exactly 2 expected, but 5 found -;;; -;;; FIXME: These variables were deprecated in late February 2004, and -;;; can probably be removed in about a year. -(defvar *debug-print-level* 5 +(defvar *debug-print-variable-alist* nil #!+sb-doc - "(This is deprecated in favor of *DEBUG-PRINT-VARIABLE-ALIST*.) + "an association list describing new bindings for special variables +to be used within the debugger. Eg. -*PRINT-LEVEL* for the debugger") -(defvar *debug-print-length* 7 - #!+sb-doc - "(This is deprecated in favor of *DEBUG-PRINT-VARIABLE-ALIST*.) + ((*PRINT-LENGTH* . 10) (*PRINT-LEVEL* . 6) (*PRINT-PRETTY* . NIL)) -*PRINT-LENGTH* for the debugger") +The variables in the CAR positions are bound to the values in the CDR +during the execution of some debug commands. When evaluating arbitrary +expressions in the debugger, the normal values of the printer control +variables are in effect. -(defvar *debug-print-variable-alist* nil - #!+sb-doc - "an association list describing new bindings for special variables -(typically *PRINT-FOO* variables) to be used within the debugger, e.g. -((*PRINT-LENGTH* . 10) (*PRINT-LEVEL* . 6) (*PRINT-PRETTY* . NIL))") +Initially empty, *DEBUG-PRINT-VARIABLE-ALIST* is typically used to +provide bindings for printer control variables.") (defvar *debug-readtable* ;; KLUDGE: This can't be initialized in a cold toplevel form, @@ -98,7 +93,7 @@ Any command -- including the name of a restart -- may be uniquely abbreviated. The debugger rebinds various special variables for controlling i/o, sometimes to defaults (much like WITH-STANDARD-IO-SYNTAX does) and sometimes to - its own special values, e.g. SB-DEBUG:*DEBUG-PRINT-LEVEL*. + its own special values, based on SB-EXT:*DEBUG-PRINT-VARIBALE-ALIST*. Debug commands do not affect *, //, and similar variables, but evaluation in the debug loop does affect these variables. SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt @@ -377,62 +372,56 @@ Other commands: (original-package *package*) (original-print-pretty *print-pretty*)) (with-standard-io-syntax - (let (;; We want the printer and reader to be in a useful state, - ;; regardless of where the debugger was invoked in the - ;; program. WITH-STANDARD-IO-SYNTAX did much of what we - ;; want, but - ;; * It doesn't affect our internal special variables - ;; like *CURRENT-LEVEL-IN-PRINT*. - ;; * It isn't customizable. - ;; * It doesn't set *PRINT-READABLY* to the same value - ;; as the toplevel default. - ;; * It sets *PACKAGE* to COMMON-LISP-USER, which is not - ;; helpful behavior for a debugger. - ;; * There's no particularly good debugger default for - ;; *PRINT-PRETTY*, since T is usually what you want - ;; -- except absolutely not what you want when you're - ;; debugging failures in PRINT-OBJECT logic. - ;; We try to address all these issues with explicit - ;; rebindings here. - (sb!kernel:*current-level-in-print* 0) - (*package* original-package) - (*print-pretty* original-print-pretty) - (*print-readably* nil) - ;; Clear the circularity machinery to try to to reduce the - ;; pain from sharing the circularity table across all - ;; streams; if these are not rebound here, then setting - ;; *PRINT-CIRCLE* within the debugger when debugging in a - ;; state where something circular was being printed (e.g., - ;; because the debugger was entered on an error in a - ;; PRINT-OBJECT method) makes a hopeless mess. Binding them - ;; here does seem somewhat ugly because it makes it more - ;; difficult to debug the printing-of-circularities code - ;; itself; however, as far as I (WHN, 2004-05-29) can see, - ;; that's almost entirely academic as long as there's one - ;; shared *C-H-T* for all streams (i.e., it's already - ;; unreasonably difficult to debug print-circle machinery - ;; given the buggy crosstalk between the debugger streams - ;; and the stream you're trying to watch), and any fix for - ;; that buggy arrangement will likely let this hack go away - ;; naturally. - (sb!impl::*circularity-hash-table* . nil) - (sb!impl::*circularity-counter* . nil) - ;; These rebindings are now (as of early 2004) deprecated, - ;; with the new *PRINT-VAR-ALIST* mechanism preferred. - (*print-length* *debug-print-length*) - (*print-level* *debug-print-level*) - (*readtable* *debug-readtable*)) - (progv - ;; (Why NREVERSE? PROGV makes the later entries have - ;; precedence over the earlier entries. - ;; *DEBUG-PRINT-VARIABLE-ALIST* is called an alist, so it's - ;; expected that its earlier entries have precedence. And - ;; the earlier-has-precedence behavior is mostly more - ;; convenient, so that programmers can use PUSH or LIST* to - ;; customize *DEBUG-PRINT-VARIABLE-ALIST*.) - (nreverse (mapcar #'car *debug-print-variable-alist*)) - (nreverse (mapcar #'cdr *debug-print-variable-alist*)) - (apply fun rest)))))) + (with-sane-io-syntax + (let (;; We want the printer and reader to be in a useful + ;; state, regardless of where the debugger was invoked + ;; in the program. WITH-STANDARD-IO-SYNTAX and + ;; WITH-SANE-IO-SYNTAX do much of what we want, but + ;; * It doesn't affect our internal special variables + ;; like *CURRENT-LEVEL-IN-PRINT*. + ;; * It isn't customizable. + ;; * It sets *PACKAGE* to COMMON-LISP-USER, which is not + ;; helpful behavior for a debugger. + ;; * There's no particularly good debugger default for + ;; *PRINT-PRETTY*, since T is usually what you want + ;; -- except absolutely not what you want when you're + ;; debugging failures in PRINT-OBJECT logic. + ;; We try to address all these issues with explicit + ;; rebindings here. + (sb!kernel:*current-level-in-print* 0) + (*package* original-package) + (*print-pretty* original-print-pretty) + ;; Clear the circularity machinery to try to to reduce the + ;; pain from sharing the circularity table across all + ;; streams; if these are not rebound here, then setting + ;; *PRINT-CIRCLE* within the debugger when debugging in a + ;; state where something circular was being printed (e.g., + ;; because the debugger was entered on an error in a + ;; PRINT-OBJECT method) makes a hopeless mess. Binding them + ;; here does seem somewhat ugly because it makes it more + ;; difficult to debug the printing-of-circularities code + ;; itself; however, as far as I (WHN, 2004-05-29) can see, + ;; that's almost entirely academic as long as there's one + ;; shared *C-H-T* for all streams (i.e., it's already + ;; unreasonably difficult to debug print-circle machinery + ;; given the buggy crosstalk between the debugger streams + ;; and the stream you're trying to watch), and any fix for + ;; that buggy arrangement will likely let this hack go away + ;; naturally. + (sb!impl::*circularity-hash-table* . nil) + (sb!impl::*circularity-counter* . nil) + (*readtable* *debug-readtable*)) + (progv + ;; (Why NREVERSE? PROGV makes the later entries have + ;; precedence over the earlier entries. + ;; *DEBUG-PRINT-VARIABLE-ALIST* is called an alist, so it's + ;; expected that its earlier entries have precedence. And + ;; the earlier-has-precedence behavior is mostly more + ;; convenient, so that programmers can use PUSH or LIST* to + ;; customize *DEBUG-PRINT-VARIABLE-ALIST*.) + (nreverse (mapcar #'car *debug-print-variable-alist*)) + (nreverse (mapcar #'cdr *debug-print-variable-alist*)) + (apply fun rest))))))) ;;; the ordinary ANSI case of INVOKE-DEBUGGER, when not suppressed by ;;; command-line --disable-debugger option diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 6a95f38..797f149 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -1157,3 +1157,17 @@ (*read-suppress* *read-suppress*) (*readtable* *readtable*)) (funcall function))) + +;;; Bind a few "potentially dangerous" printer control variables to +;;; safe values, respecting current values if possible. +(defmacro with-sane-io-syntax (&body forms) + `(call-with-sane-io-syntax (lambda () ,@forms))) + +(defun call-with-sane-io-syntax (function) + (declare (type function function)) + (macrolet ((true (sym) + `(and (boundp ',sym) ,sym))) + (let ((*print-readably* nil) + (*print-level* (or (true *print-level*) 6)) + (*print-length* (or (true *print-length*) 12))) + (funcall function)))) diff --git a/src/code/error.lisp b/src/code/error.lisp index 51acf0e..b409a4f 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -17,9 +17,10 @@ (defun style-warn (format-control &rest format-arguments) (/show0 "entering STYLE-WARN") (/show format-control format-arguments) - (warn 'simple-style-warning - :format-control format-control - :format-arguments format-arguments)) + (with-sane-io-syntax + (warn 'simple-style-warning + :format-control format-control + :format-arguments format-arguments))) ;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and ;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp index ea34114..d8d529c 100644 --- a/src/compiler/ir1report.lisp +++ b/src/compiler/ir1report.lisp @@ -16,27 +16,6 @@ (declaim (special *current-path*)) -;;; We bind print level and length when printing out messages so that -;;; we don't dump huge amounts of garbage. -;;; -;;; FIXME: It's not possible to get the defaults right for everyone. -;;; So: Should these variables be in the SB-EXT package? Or should we -;;; just get rid of them completely and just use the bare -;;; CL:*PRINT-FOO* variables instead? -(declaim (type (or unsigned-byte null) - *compiler-error-print-level* - *compiler-error-print-length* - *compiler-error-print-lines*)) -(defvar *compiler-error-print-level* 5 - #!+sb-doc - "the value for *PRINT-LEVEL* when printing compiler error messages") -(defvar *compiler-error-print-length* 10 - #!+sb-doc - "the value for *PRINT-LENGTH* when printing compiler error messages") -(defvar *compiler-error-print-lines* 12 - #!+sb-doc - "the value for *PRINT-LINES* when printing compiler error messages") - (defvar *enclosing-source-cutoff* 1 #!+sb-doc "The maximum number of enclosing non-original source forms (i.e. from @@ -188,14 +167,11 @@ ;;; compiler warnings. (defun stringify-form (form &optional (pretty t)) (with-standard-io-syntax - (let ((*print-readably* nil) - (*print-pretty* pretty) - (*print-level* *compiler-error-print-level*) - (*print-length* *compiler-error-print-length*) - (*print-lines* *compiler-error-print-lines*)) - (if pretty - (format nil "~<~@; ~S~:>" (list form)) - (prin1-to-string form))))) + (with-compiler-io-syntax + (let ((*print-pretty* pretty)) + (if pretty + (format nil "~<~@; ~S~:>" (list form)) + (prin1-to-string form)))))) ;;; Return a COMPILER-ERROR-CONTEXT structure describing the current ;;; error context, or NIL if we can't figure anything out. ARGS is a @@ -285,11 +261,13 @@ ;;; ;;; We suppress printing of messages identical to the previous, but ;;; record the number of times that the message is repeated. -(defun print-compiler-message (format-string format-args) +(defmacro print-compiler-message (format-string format-args) + `(with-compiler-io-syntax + (%print-compiler-message ,format-string ,format-args))) +(defun %print-compiler-message (format-string format-args) (declare (type simple-string format-string)) - (declare (type list format-args)) - + (declare (type list format-args)) (let ((stream *error-output*) (context (find-error-context format-args))) (cond @@ -362,14 +340,11 @@ (note-message-repeats nil) (setq *last-format-string* format-string) (setq *last-format-args* format-args) - (let ((*print-level* *compiler-error-print-level*) - (*print-length* *compiler-error-print-length*) - (*print-lines* *compiler-error-print-lines*)) - (format stream "~&") - (pprint-logical-block (stream nil :per-line-prefix "; ") - (format stream "~&~?" format-string format-args)) - (format stream "~&")))) - + (format stream "~&") + (pprint-logical-block (stream nil :per-line-prefix "; ") + (format stream "~&~?" format-string format-args)) + (format stream "~&"))) + (incf *last-message-count*) (values)) diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index 3e1e337..7016312 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -944,3 +944,29 @@ (defmacro position-or-lose (&rest args) `(or (position ,@args) (error "shouldn't happen?"))) + +;;; user-definable compiler io syntax + +;;; We use WITH-SANE-IO-SYNTAX to provide safe defaults, and provide +;;; *COMPILER-PRINT-VARIABLE-ALIST* for user customization. +(defvar *compiler-print-variable-alist* nil + #!+sb-doc + "an association list describing new bindings for special variables +to be used by the compiler for error-reporting, etc. Eg. + + ((*PRINT-LENGTH* . 10) (*PRINT-LEVEL* . 6) (*PRINT-PRETTY* . NIL)) + +The variables in the CAR positions are bound to the values in the CDR +during the execution of some debug commands. When evaluating arbitrary +expressions in the debugger, the normal values of the printer control +variables are in effect. + +Initially empty, *COMPILER-PRINT-VARIABLE-ALIST* is Typically used to +specify bindings for printer control variables.") + +(defmacro with-compiler-io-syntax (&body forms) + `(with-sane-io-syntax + (progv + (nreverse (mapcar #'car *compiler-print-variable-alist*)) + (nreverse (mapcar #'cdr *compiler-print-variable-alist*)) + ,@forms))) diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index a23302f..5f9aa1d 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -551,6 +551,17 @@ (warning (c) (error "shouldn't warn just from macroexpansion here")))) +;;; bug 318 symptom no 1. (rest not fixed yet) +(catch :ok + (handler-bind ((error (lambda (c) + ;; Used to cause stack-exhaustion + (unless (typep c 'storege-condition) + (throw :ok))))) + (eval '(progn + (defstruct foo a) + (setf (find-class 'foo) nil) + (defstruct foo slot-1))))) + ;;; success (format t "~&/returning success~%") (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index d691460..82c92ec 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.16.10" +"0.8.16.11" -- 1.7.10.4