Patch backported by Sage. Fix from upstream that happens to work around https://trac.sagemath.org/ticket/23011 diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 77ca799..53b887c 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -307,11 +307,13 @@ :start (format-directive-start struct) :end (format-directive-end struct)))) +(defconstant +format-directive-limit+ (1+ (char-code #\~))) + #+formatter (defparameter *format-directive-expanders* - (make-array char-code-limit :initial-element nil)) + (make-array +format-directive-limit+ :initial-element nil)) (defparameter *format-directive-interpreters* - (make-array char-code-limit :initial-element nil)) + (make-array +format-directive-limit+ :initial-element nil)) (defparameter *default-format-error-control-string* nil) (defparameter *default-format-error-offset* nil) @@ -550,24 +552,24 @@ (write-string directive stream) (interpret-directive-list stream (cdr directives) orig-args args)) (#-ecl format-directive #+ecl vector + (multiple-value-bind + (new-directives new-args) + (let* ((code (char-code (format-directive-character directive))) + (function + (and (< code +format-directive-limit+) + (svref *format-directive-interpreters* code))) + (*default-format-error-offset* + (1- (format-directive-end directive)))) + (unless function + (error 'format-error + :complaint "Unknown format directive.")) (multiple-value-bind (new-directives new-args) - (let ((function - (svref *format-directive-interpreters* - (char-code (format-directive-character - directive)))) - (*default-format-error-offset* - (1- (format-directive-end directive)))) - (unless function - (error 'format-error - :complaint "Unknown format directive.")) - (multiple-value-bind - (new-directives new-args) - (funcall function stream directive - (cdr directives) orig-args args) - (values new-directives new-args))) - (interpret-directive-list stream new-directives - orig-args new-args))))) + (funcall function stream directive + (cdr directives) orig-args args) + (values new-directives new-args))) + (interpret-directive-list stream new-directives + orig-args new-args))))) args)) @@ -639,11 +641,12 @@ (values `(write-string ,directive stream) more-directives)) (format-directive - (let ((expander - (aref *format-directive-expanders* - (char-code (format-directive-character directive)))) - (*default-format-error-offset* - (1- (format-directive-end directive)))) + (let* ((code (char-code (format-directive-character directive))) + (expander + (and (< code +format-directive-limit+) + (svref *format-directive-expanders* code))) + (*default-format-error-offset* + (1- (format-directive-end directive)))) (if expander (funcall expander directive more-directives) (error 'format-error