gnu/packages/patches/ecl-16-format-directive-limit.patch

   1 Patch backported by Sage.
   2
   3 Fix from upstream that happens to work around
   4 https://trac.sagemath.org/ticket/23011
   5 diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp
   6 index 77ca799..53b887c 100644
   7 --- a/src/lsp/format.lsp
   8 +++ b/src/lsp/format.lsp
   9 @@ -307,11 +307,13 @@
  10                    :start (format-directive-start struct)
  11                    :end (format-directive-end struct))))
  12
  13 +(defconstant +format-directive-limit+ (1+ (char-code #\~)))
  14 +
  15  #+formatter
  16  (defparameter *format-directive-expanders*
  17 -  (make-array char-code-limit :initial-element nil))
  18 +  (make-array +format-directive-limit+ :initial-element nil))
  19  (defparameter *format-directive-interpreters*
  20 -  (make-array char-code-limit :initial-element nil))
  21 +  (make-array +format-directive-limit+ :initial-element nil))
  22
  23  (defparameter *default-format-error-control-string* nil)
  24  (defparameter *default-format-error-offset* nil)
  25 @@ -550,24 +552,24 @@
  26             (write-string directive stream)
  27             (interpret-directive-list stream (cdr directives) orig-args args))
  28            (#-ecl format-directive #+ecl vector
  29 +           (multiple-value-bind
  30 +                 (new-directives new-args)
  31 +               (let* ((code (char-code (format-directive-character directive)))
  32 +                      (function
  33 +                        (and (< code +format-directive-limit+)
  34 +                             (svref *format-directive-interpreters* code)))
  35 +                      (*default-format-error-offset*
  36 +                        (1- (format-directive-end directive))))
  37 +                 (unless function
  38 +                   (error 'format-error
  39 +                          :complaint "Unknown format directive."))
  40                   (multiple-value-bind
  41                         (new-directives new-args)
  42 -                     (let ((function
  43 -                            (svref *format-directive-interpreters*
  44 -                                   (char-code (format-directive-character
  45 -                                               directive))))
  46 -                           (*default-format-error-offset*
  47 -                            (1- (format-directive-end directive))))
  48 -                       (unless function
  49 -                         (error 'format-error
  50 -                                :complaint "Unknown format directive."))
  51 -                       (multiple-value-bind
  52 -                             (new-directives new-args)
  53 -                           (funcall function stream directive
  54 -                                    (cdr directives) orig-args args)
  55 -                         (values new-directives new-args)))
  56 -                   (interpret-directive-list stream new-directives
  57 -                                             orig-args new-args)))))
  58 +                     (funcall function stream directive
  59 +                              (cdr directives) orig-args args)
  60 +                   (values new-directives new-args)))
  61 +             (interpret-directive-list stream new-directives
  62 +                                       orig-args new-args)))))
  63        args))
  64
  65  \f
  66 @@ -639,11 +641,12 @@
  67         (values `(write-string ,directive stream)
  68                 more-directives))
  69        (format-directive
  70 -       (let ((expander
  71 -              (aref *format-directive-expanders*
  72 -                    (char-code (format-directive-character directive))))
  73 -             (*default-format-error-offset*
  74 -              (1- (format-directive-end directive))))
  75 +       (let* ((code (char-code (format-directive-character directive)))
  76 +              (expander
  77 +                (and (< code +format-directive-limit+)
  78 +                     (svref *format-directive-expanders* code)))
  79 +              (*default-format-error-offset*
  80 +                (1- (format-directive-end directive))))
  81           (if expander
  82               (funcall expander directive more-directives)
  83               (error 'format-error