bug#31772: 26.1; (thing-at-point 'list) regression

[Leo Liu <sdl.web@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 350 bytes --]

On 2018-09-11 14:16 +0300, Eli Zaretskii wrote:
> Would you mind submitting a patch that includes the above, and also
> fixes/augments the tests accordingly?  I think these changes then
> could go into the emacs-26 branch, unless someone raises objections.

Please find the new patch in the attachment. Thanks a lot for helping
straighten this out.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: thing.diff --]
[-- Type: text/x-patch, Size: 5310 bytes --]

diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 6a978fe9..fdc12f32 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -221,15 +221,12 @@ The bounds of THING are determined by `bounds-of-thing-at-point'."
   "Return the bounds of the list at point.
 \[Internal function used by `bounds-of-thing-at-point'.]"
   (save-excursion
-    (let* ((st (parse-partial-sexp (point-min) (point)))
-           (beg (or (and (eq 4 (car (syntax-after (point))))
-                         (not (nth 8 st))
-                         (point))
-                    (nth 1 st))))
-      (when beg
-        (goto-char beg)
-        (forward-sexp)
-        (cons beg (point))))))
+    (if (ignore-errors (up-list -1))
+	(ignore-errors (cons (point) (progn (forward-sexp) (point))))
+      (let ((bound (bounds-of-thing-at-point 'sexp)))
+	(and bound
+	     (<= (car bound) (point)) (< (point) (cdr bound))
+	     bound)))))
 
 ;; Defuns
 
@@ -608,8 +605,13 @@ Signal an error if the entire string was not used."
 
 (put 'number 'thing-at-point 'number-at-point)
 ;;;###autoload
-(defun list-at-point ()
-  "Return the Lisp list at point, or nil if none is found."
-  (form-at-point 'list 'listp))
+(defun list-at-point (&optional ignore-comment-or-string)
+  "Return the Lisp list at point, or nil if none is found.
+If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are
+treated as white space."
+  (let ((ppss (and ignore-comment-or-string (syntax-ppss))))
+    (save-excursion
+      (goto-char (or (nth 8 ppss) (point)))
+      (form-at-point 'list 'listp))))
 
 ;;; thingatpt.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index cfb57de6..43172f4f 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -84,41 +84,44 @@ position to retrieve THING.")
       (goto-char (nth 1 test))
       (should (equal (thing-at-point (nth 2 test)) (nth 3 test))))))
 
-;; These tests reflect the actual behavior of
-;; `thing-at-point-bounds-of-list-at-point'.
-(ert-deftest thing-at-point-bug24627 ()
-  "Test for https://debbugs.gnu.org/24627 ."
-  (let ((string-result '(("(a \"b\" c)" . (a "b" c))
-                         (";(a \"b\" c)")
-                         ("(a \"b\" c\n)" . (a "b" c))
-                         ("\"(a b c)\"")
-                         ("(a ;(b c d)\ne)" . (a e))
-                         ("(foo\n(a ;(b c d)\ne) bar)" . (a e))
-                         ("(foo\na ;(b c d)\ne bar)" . (foo a e bar))
-                         ("(foo\n(a \"(b c d)\"\ne) bar)" . (a "(b c d)" e))
-                         ("(b\n(a ;(foo c d)\ne) bar)" . (a e))
-                         ("(princ \"(a b c)\")" . (princ "(a b c)"))
-                         ("(defun foo ()\n  \"Test function.\"\n  ;;(a b)\n  nil)" . (defun foo nil "Test function." nil))))
-        (file
-         (expand-file-name "lisp/thingatpt.el" source-directory))
-        buf)
-    ;; Test for `thing-at-point'.
-    (when (file-exists-p file)
-      (unwind-protect
-          (progn
-            (setq buf (find-file file))
-            (goto-char (point-max))
-            (forward-line -1)
-            (should-not (thing-at-point 'list)))
-        (kill-buffer buf)))
-    ;; Tests for `list-at-point'.
-    (dolist (str-res string-result)
-      (with-temp-buffer
-        (emacs-lisp-mode)
-        (insert (car str-res))
-        (re-search-backward "\\((a\\|^a\\)")
-        (should (equal (list-at-point)
-                       (cdr str-res)))))))
+;; See bug#24627 and bug#31772.
+(ert-deftest thing-at-point-bounds-of-list-at-point ()
+  (cl-macrolet ((with-test-buffer (str &rest body)
+                  `(with-temp-buffer
+                     (emacs-lisp-mode)
+                     (insert ,str)
+                     (search-backward "|")
+                     (delete-char 1)
+                     ,@body)))
+    (let ((tests1
+           '(("|(a \"b\" c)" (a "b" c))
+             (";|(a \"b\" c)" (a "b" c) nil)
+             ("|(a \"b\" c\n)" (a "b" c))
+             ("\"|(a b c)\"" (a b c) nil)
+             ("|(a ;(b c d)\ne)" (a e))
+             ("(foo\n|(a ;(b c d)\ne) bar)" (foo (a e) bar))
+             ("(foo\n|a ;(b c d)\ne bar)" (foo a e bar))
+             ("(foo\n|(a \"(b c d)\"\ne) bar)" (foo (a "(b c d)" e) bar))
+             ("(b\n|(a ;(foo c d)\ne) bar)" (b (a e) bar))
+             ("(princ \"|(a b c)\")" (a b c) (princ "(a b c)"))
+             ("(defun foo ()\n  \"Test function.\"\n  ;;|(a b)\n  nil)"
+              (defun foo nil "Test function." nil)
+              (defun foo nil "Test function." nil))))
+          (tests2
+           '(("|list-at-point" . "list-at-point")
+             ("list-|at-point" . "list-at-point")
+             ("list-at-point|" . nil)
+             ("|(a b c)" . "(a b c)")
+             ("(a b c)|" . nil))))
+      ;; Tests for `list-at-point'.
+      (dolist (test tests1)
+        (with-test-buffer (car test)
+          (should (equal (list-at-point) (cl-second test)))
+          (when (cddr test)
+            (should (equal (list-at-point t) (cl-third test))))))
+      (dolist (test tests2)
+        (with-test-buffer (car test)
+          (should (equal (thing-at-point 'list) (cdr test))))))))
 
 (ert-deftest thing-at-point-url-in-comment ()
   (with-temp-buffer