bug#53965: 29.0.50; Subject: [PATCH] ietf-drums-remove-whitespace fails on unmatched " and (

bug#53965: 29.0.50; Subject: [PATCH] ietf-drums-remove-whitespace fails on unmatched " and (

[Bob Rogers]

In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.20, cairo version 1.16.0)
 of 2022-02-10 built on orion
Repository revision: 2469e036035f8f5baa78e1557c61df019d8fd572
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12003000
System Description: openSUSE Leap 15.3

Configured using:
 'configure --with-dbus=no --with-gsettings=no --with-gif=ifavailable
 --with-tiff=no --with-gnutls=yes --with-gconf=no'

Configured features:
ACL CAIRO FREETYPE GIF GLIB GMP GNUTLS HARFBUZZ JPEG LIBSELINUX LIBXML2
MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS
TOOLKIT_SCROLL_BARS X11 XDBE XIM XPM GTK3 ZLIB

   Evaluating (e.g.) 

	(ietf-drums-remove-whitespace "random (unterminated comment")

gets a scan-error, and similarly if the "(" is replaced with a "\"".
The patch below makes it work, does some code consolidation, and adds
regression tests.
					-- Bob Rogers
					   http://www.rgrjr.com/

------------------------------------------------------------------------
From 97083141917360149b65851f4615fabc0d8c9462 Mon Sep 17 00:00:00 2001
From: Bob Rogers <rogers@rgrjr.com>
Date: Fri, 11 Feb 2022 23:42:17 -0500
Subject: [PATCH] Fix ietf-drums-remove-whitespace unmatched " and (

* lisp/mail/ietf-drums.el:
   + (ietf-drums-skip-comment):  New helper function.
   + (ietf-drums-remove-comments):  Use ietf-drums-skip-comment.
   + (ietf-drums-remove-whitespace):  Handle unterminated quotes and
     comments, as ietf-drums-remove-comments already does.
* test/lisp/mail/ietf-drums-tests.el:
   + Test unterminated quote and comment for
     ietf-drums-remove-whitespace and ietf-drums-remove-comments.
---
 lisp/mail/ietf-drums.el            | 30 ++++++++++++++++++++----------
 test/lisp/mail/ietf-drums-tests.el | 16 ++++++++++++++++
 2 files changed, 36 insertions(+), 10 deletions(-)

diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index db77aba172..886de7c9d6 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -65,6 +65,21 @@ ietf-drums-syntax-table
     (modify-syntax-entry ?\' "_" table)
     table))
 
+(defvar ietf-drums-comment-syntax-table
+  (let ((table (copy-syntax-table ietf-drums-syntax-table)))
+    (modify-syntax-entry ?\" "w" table)
+    table)
+  "In comments, DQUOTE is normal and does not start a string.")
+
+(defun ietf-drums--skip-comment ()
+  ;; From just before the start of a comment, go to the end.  Returns
+  ;; point.  If the comment is unterminated, go to point-max.
+  (condition-case ()
+      (with-syntax-table ietf-drums-comment-syntax-table
+	(forward-sexp 1))
+    (scan-error (goto-char (point-max))))
+  (point))
+
 (defun ietf-drums-token-to-list (token)
   "Translate TOKEN into a list of characters."
   (let ((i 0)
@@ -109,14 +124,7 @@ ietf-drums-remove-comments
 	      (forward-sexp 1)
 	    (error (goto-char (point-max)))))
 	 ((eq c ?\()
-	  (delete-region
-	       (point)
-	       (condition-case nil
-		   (with-syntax-table (copy-syntax-table ietf-drums-syntax-table)
-		     (modify-syntax-entry ?\" "w")
-		     (forward-sexp 1)
-		     (point))
-		 (error (point-max)))))
+	  (delete-region (point) (ietf-drums--skip-comment)))
 	 (t
 	  (forward-char 1))))
       (buffer-string))))
@@ -130,9 +138,11 @@ ietf-drums-remove-whitespace
 	(setq c (char-after))
 	(cond
 	 ((eq c ?\")
-	  (forward-sexp 1))
+	   (condition-case ()
+	       (forward-sexp 1)
+	     (scan-error (goto-char (point-max)))))
 	 ((eq c ?\()
-	  (forward-sexp 1))
+           (ietf-drums--skip-comment))
 	 ((memq c '(?\  ?\t ?\n ?\r))
 	  (delete-char 1))
 	 (t
diff --git a/test/lisp/mail/ietf-drums-tests.el b/test/lisp/mail/ietf-drums-tests.el
index 4cc38b8763..b13937bf73 100644
--- a/test/lisp/mail/ietf-drums-tests.el
+++ b/test/lisp/mail/ietf-drums-tests.el
@@ -40,6 +40,16 @@ ietf-drums-tests
   (should (equal (ietf-drums-remove-comments
                   "random (first) (second (and)) (third) not fourth")
                  "random    not fourth"))
+  ;; Test some unterminated comments.
+  (should (equal (ietf-drums-remove-comments "test an (unterminated comment")
+                 "test an "))
+  (should (equal (ietf-drums-remove-comments "test an \"unterminated quote")
+                 ;; returns the string unchanged (and doesn't barf).
+                 "test an \"unterminated quote"))
+  (should (equal (ietf-drums-remove-comments
+                  ;; note that double-quote is not special.
+                  "test (unterminated comments with \"quoted (\" )stuff")
+                 "test "))
 
   ;; ietf-drums-remove-whitespace
   (should (equal (ietf-drums-remove-whitespace "random string")
@@ -53,6 +63,12 @@ ietf-drums-tests
   (should (equal (ietf-drums-remove-whitespace
                   "random (first) (second (and)) (third) not fourth")
                  "random(first)(second (and))(third)notfourth"))
+  ;; Test some unterminated comments and quotes.
+  (should (equal (ietf-drums-remove-whitespace
+                  "random (first) (second (and)) (third unterminated")
+                 "random(first)(second (and))(third unterminated"))
+  (should (equal (ietf-drums-remove-whitespace "random \"non terminated string")
+                 "random\"non terminated string"))
 
   ;; ietf-drums-strip
   (should (equal (ietf-drums-strip "random string") "randomstring"))
-- 
2.34.1

bug#53965: 29.0.50; Subject: [PATCH] ietf-drums-remove-whitespace fails on unmatched " and (

[Lars Ingebrigtsen]

Bob Rogers <rogers@rgrjr.com> writes:

> The patch below makes it work, does some code consolidation, and adds
> regression tests.

Thanks; pushed to Emacs 29 (with some indentation changes).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no