me
/
guix
Archived
1
0
Fork 0
This repository has been archived on 2024-08-07. You can view files and clone it, but cannot push or open issues/pull-requests.
guix/gnu/packages/patches/ecl-16-format-directive-lim...

84 lines
3.8 KiB
Diff
Raw Blame History

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

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