1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00

pp.el: Try and fix bug#70039

* lisp/emacs-lisp/pp.el (pp-fill): Avoid splitting `#N#` or `#[`.
* test/lisp/emacs-lisp/pp-tests.el (pp-tests--sanity): New test.
This commit is contained in:
Stefan Monnier 2024-03-28 15:31:04 -04:00
parent de9e913f9e
commit 4cee95815b
2 changed files with 36 additions and 10 deletions

View File

@ -166,12 +166,19 @@ it inserts and pretty-prints that arg at point."
(interactive "r")
(if (null end) (pp--object beg #'pp-fill)
(goto-char beg)
(let ((end (copy-marker end t))
(newline (lambda ()
(skip-chars-forward ")]}")
(unless (save-excursion (skip-chars-forward " \t") (eolp))
(insert "\n")
(indent-according-to-mode)))))
(let* ((end (copy-marker end t))
(avoid-unbreakable
(lambda ()
(and (memq (char-before) '(?# ?s ?f))
(memq (char-after) '(?\[ ?\())
(looking-back "#[sf]?" (- (point) 2))
(goto-char (match-beginning 0)))))
(newline (lambda ()
(skip-chars-forward ")]}")
(unless (save-excursion (skip-chars-forward " \t") (eolp))
(funcall avoid-unbreakable)
(insert "\n")
(indent-according-to-mode)))))
(while (progn (forward-comment (point-max))
(< (point) end))
(let ((beg (point))
@ -198,10 +205,10 @@ it inserts and pretty-prints that arg at point."
;; reduce the indentation depth.
;; Similarly, we prefer to cut before a "." than after
;; it because it reduces the indentation depth.
(while (not (zerop (skip-chars-backward " \t({[',.")))
(and (memq (char-before) '(?# ?s ?f))
(looking-back "#[sf]?" (- (point) 2))
(goto-char (match-beginning 0))))
(while
(progn
(funcall avoid-unbreakable)
(not (zerop (skip-chars-backward " \t({[',.")))))
(if (bolp)
;; The sexp already starts on its own line.
(progn (goto-char beg) nil)

View File

@ -66,4 +66,23 @@
(while (search-forward "." nil t)
(should (not (eolp))))))
(ert-deftest pp-tests--sanity ()
(with-temp-buffer
(lisp-data-mode)
(let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))"))
(let ((res (car (read-from-string testdata))))
(dotimes (i (length testdata))
(erase-buffer)
(insert testdata)
(let ((fill-column i))
(pp-fill (point-min) (point-max))
(goto-char (point-min))
(condition-case err
(should (equal (read (current-buffer)) res))
(invalid-read-syntax
(message "Invalid fill result with i=%d:\n%s"
i (buffer-string))
(signal (car err) (cdr err))
))))))))
;;; pp-tests.el ends here.