Subject: bug#33414: 27.0.50; inhibit-changing-match-data can be t in syntax-propertize functions, breaking backtrace and looking-at

From: Lars Ingebrigtsen <[email-masked]>
Date: Sun, 05 Sep 2021 11:29:38 +0200

Philipp <[email-masked]> writes:

>> `inhibit-changing-match-data' just seems like a bad interface to me.
>
> Yes, using a public dynamic variable (i.e., public global mutable
> state) to influence the behavior of a function is normally a bad idea.

I've now implemented this, but out of an abundance of caution, I'm
waiting for the Emacs 29 branch to open before pushing it (which should
be in a couple of weeks).

I append the work in progress for reference.

diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 68061f0b09..0d9defec4d 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1968,7 +1968,7 @@ Regexp Search
 not worth the trouble of implementing that.
 @end deffn
 
-@defun string-match regexp string &optional start
+@defun string-match regexp string &optional start inhibit-modify
 This function returns the index of the start of the first match for
 the regular expression @var{regexp} in @var{string}, or @code{nil} if
 there is no match.  If @var{start} is non-@code{nil}, the search starts
@@ -1993,8 +1993,10 @@ Regexp Search
 The index of the first character of the
 string is 0, the index of the second character is 1, and so on.
 
-If this function finds a match, the index of the first character beyond
-the match is available as @code{(match-end 0)}.  @xref{Match Data}.
+By default, if this function finds a match, the index of the first
+character beyond the match is available as @code{(match-end 0)}.
+@xref{Match Data}.  If @var{inhibit-modify} is non-@code{nil}, the
+match data isn't modified.
 
 @example
 @group
@@ -2015,16 +2017,17 @@ Regexp Search
 avoids modifying the match data.
 @end defun
 
-@defun looking-at regexp
+@defun looking-at regexp &optional inhibit-save
 This function determines whether the text in the current buffer directly
 following point matches the regular expression @var{regexp}.  ``Directly
 following'' means precisely that: the search is ``anchored'' and it can
 succeed only starting with the first character following point.  The
 result is @code{t} if so, @code{nil} otherwise.
 
-This function does not move point, but it does update the match data.
-@xref{Match Data}.  If you need to test for a match without modifying
-the match data, use @code{looking-at-p}, described below.
+This function does not move point, but it does update the match data
+(if @var{inhibit-modify} is @code{nil} or missing, which is the
+default).  @xref{Match Data}.  If you need to test for a match without
+modifying the match data, use @code{looking-at-p}, described below.
 
 In this example, point is located directly before the @samp{T}.  If it
 were anywhere else, the result would be @code{nil}.
@@ -2131,13 +2134,13 @@ POSIX Regexps
 matching.
 @end deffn
 
-@defun posix-looking-at regexp
+@defun posix-looking-at regexp &optional inhibit-modify
 This is like @code{looking-at} except that it performs the full
 backtracking specified by the POSIX standard for regular expression
 matching.
 @end defun
 
-@defun posix-string-match regexp string &optional start
+@defun posix-string-match regexp string &optional start inhibit-modify
 This is like @code{string-match} except that it performs the full
 backtracking specified by the POSIX standard for regular expression
 matching.
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 6919738398..450a97a7ed 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1447,12 +1447,13 @@ auth-source-netrc-saver
 `auth-source-netrc-cache' to avoid prompting more than once."
   (let* ((key (format "%s %s" file (rfc2104-hash 'md5 64 16 file add)))
          (cached (assoc key auth-source-netrc-cache)))
-
+    (message "hello 2 %s" cached)
     (if cached
         (auth-source-do-trivia
          "auth-source-netrc-saver: found previous run for key %s, returning"
          key)
       (with-temp-buffer
+        (message "hello 3 %s" file)
         (when (file-exists-p file)
           (insert-file-contents file))
         (when auth-source-gpg-encrypt-to
@@ -1472,8 +1473,11 @@ auth-source-netrc-saver
               (done (not (eq auth-source-save-behavior 'ask)))
               (bufname "*auth-source Help*")
               k)
+          (message "hello 3 %s %s" auth-source-save-behavior done)
           (while (not done)
+            (message "hello 3.5")
             (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
+            (message "hello 4 %s" k)
             (cl-case k
               (?y (setq done t))
               (?? (save-excursion
diff --git a/lisp/subr.el b/lisp/subr.el
index 7426dcce50..983a127594 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1746,6 +1746,7 @@ log10
 (make-obsolete 'window-redisplay-end-trigger nil "23.1")
 (make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
 (make-obsolete-variable 'operating-system-release nil "28.1")
+(make-obsolete-variable 'inhibit-changing-match-data nil "28.1")
 
 (make-obsolete 'run-window-configuration-change-hook nil "27.1")
 
@@ -4715,14 +4716,12 @@ looking-back
 (defsubst looking-at-p (regexp)
   "\
 Same as `looking-at' except this function does not change the match data."
-  (let ((inhibit-changing-match-data t))
-    (looking-at regexp)))
+  (looking-at regexp t))
 
 (defsubst string-match-p (regexp string &optional start)
   "\
 Same as `string-match' except this function does not change the match data."
-  (let ((inhibit-changing-match-data t))
-    (string-match regexp string start)))
+  (string-match regexp string start t))
 
 (defun subregexp-context-p (regexp pos &optional start)
   "Return non-nil if POS is in a normal subregexp context in REGEXP.
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 4a64caa36b..c8d8913afe 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -673,7 +673,6 @@ vc-hg--raw-dirstate-search
     (let* ((result nil)
            (flen (length fname))
            (case-fold-search nil)
-           (inhibit-changing-match-data t)
            ;; Find a conservative bound for the loop below by using
            ;; Boyer-Moore on the raw dirstate without parsing it; we
            ;; know we can't possibly find fname _after_ the last place
@@ -977,10 +976,9 @@ vc-hg--ignore-patterns-ignored-p
   "Test whether the ignore pattern set HGIP says to ignore FILENAME.
 FILENAME must be the file's true absolute name."
   (let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip))
-        (inhibit-changing-match-data t)
         (ignored nil))
     (while (and patterns (not ignored))
-      (setf ignored (string-match (pop patterns) filename)))
+      (setf ignored (string-match-p (pop patterns) filename)))
     ignored))
 
 (defvar vc-hg--cached-ignore-patterns nil
@@ -1044,7 +1042,8 @@ vc-hg--cached-dirstate-search
              (equal size (pop cache))
              (equal ascii-fname (pop cache)))
         (pop cache)
-      (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname)))
+      (let ((result (save-match-data
+                      (vc-hg--raw-dirstate-search dirstate ascii-fname))))
         (setf vc-hg--dirstate-scan-cache
               (list dirstate mtime size ascii-fname result))
         result))))
diff --git a/src/minibuf.c b/src/minibuf.c
index c9134eff67..725c4ceeb9 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1679,7 +1679,7 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
 		    specbind (Qcase_fold_search,
 			      completion_ignore_case ? Qt : Qnil);
 		  }
-		tem = Fstring_match (XCAR (regexps), eltstring, zero);
+		tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil);
 		if (NILP (tem))
 		  break;
 	      }
@@ -1943,7 +1943,7 @@ DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
 		    specbind (Qcase_fold_search,
 			      completion_ignore_case ? Qt : Qnil);
 		  }
-		tem = Fstring_match (XCAR (regexps), eltstring, zero);
+		tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil);
 		if (NILP (tem))
 		  break;
 	      }
@@ -2155,7 +2155,7 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
 	{
           /* We can test against STRING, because if we got here, then
              the element is equivalent to it.  */
-          if (NILP (Fstring_match (XCAR (regexps), string, Qnil)))
+          if (NILP (Fstring_match (XCAR (regexps), string, Qnil, Qnil)))
 	    return unbind_to (count, Qnil);
 	}
       unbind_to (count, Qnil);
diff --git a/src/search.c b/src/search.c
index 14adeb58e9..eca4413f83 100644
--- a/src/search.c
+++ b/src/search.c
@@ -260,7 +260,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp,
 
 
 static Lisp_Object
-looking_at_1 (Lisp_Object string, bool posix)
+looking_at_1 (Lisp_Object string, bool posix, bool modify_data)
 {
   Lisp_Object val;
   unsigned char *p1, *p2;
@@ -278,11 +278,11 @@ looking_at_1 (Lisp_Object string, bool posix)
   CHECK_STRING (string);
 
   /* Snapshot in case Lisp changes the value.  */
-  bool preserve_match_data = NILP (Vinhibit_changing_match_data);
+  bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data;
 
   struct regexp_cache *cache_entry = compile_pattern (
     string,
-    preserve_match_data ? &search_regs : NULL,
+    modify_match_data ? &search_regs : NULL,
     (!NILP (BVAR (current_buffer, case_fold_search))
      ? BVAR (current_buffer, case_canon_table) : Qnil),
     posix,
@@ -316,7 +316,7 @@ looking_at_1 (Lisp_Object string, bool posix)
   re_match_object = Qnil;
   i = re_match_2 (&cache_entry->buf, (char *) p1, s1, (char *) p2, s2,
 		  PT_BYTE - BEGV_BYTE,
-		  preserve_match_data ? &search_regs : NULL,
+		  modify_match_data ? &search_regs : NULL,
 		  ZV_BYTE - BEGV_BYTE);
 
   if (i == -2)
@@ -326,7 +326,7 @@ looking_at_1 (Lisp_Object string, bool posix)
     }
 
   val = (i >= 0 ? Qt : Qnil);
-  if (preserve_match_data && i >= 0)
+  if (modify_match_data && i >= 0)
   {
     for (i = 0; i < search_regs.num_regs; i++)
       if (search_regs.start[i] >= 0)
@@ -343,35 +343,37 @@ looking_at_1 (Lisp_Object string, bool posix)
   return unbind_to (count, val);
 }
 
-DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
+DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 2, 0,
        doc: /* Return t if text after point matches regular expression REGEXP.
-This function modifies the match data that `match-beginning',
-`match-end' and `match-data' access; save and restore the match
-data if you want to preserve them.  */)
-  (Lisp_Object regexp)
+By default, this function modifies the match data that
+`match-beginning', `match-end' and `match-data' access.  If
+INHIBIT-MODIFY is non-nil, don't modify the match data.  */)
+  (Lisp_Object regexp, Lisp_Object inhibit_modify)
 {
-  return looking_at_1 (regexp, 0);
+  return looking_at_1 (regexp, 0, NILP (inhibit_modify));
 }
 
-DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
+DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 2, 0,
        doc: /* Return t if text after point matches REGEXP according to Posix rules.
 Find the longest match, in accordance with Posix regular expression rules.
-This function modifies the match data that `match-beginning',
-`match-end' and `match-data' access; save and restore the match
-data if you want to preserve them.  */)
-  (Lisp_Object regexp)
+
+By default, this function modifies the match data that
+`match-beginning', `match-end' and `match-data' access.  If
+INHIBIT-MODIFY is non-nil, don't modify the match data.  */)
+  (Lisp_Object regexp, Lisp_Object inhibit_modify)
 {
-  return looking_at_1 (regexp, 1);
+  return looking_at_1 (regexp, 1, NILP (inhibit_modify));
 }
 
 static Lisp_Object
 string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
-		bool posix)
+		bool posix, bool modify_data)
 {
   ptrdiff_t val;
   struct re_pattern_buffer *bufp;
   EMACS_INT pos;
   ptrdiff_t pos_byte, i;
+  bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data;
 
   if (running_asynch_code)
     save_search_regs ();
@@ -400,8 +402,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
 			 BVAR (current_buffer, case_eqv_table));
 
   bufp = &compile_pattern (regexp,
-                           (NILP (Vinhibit_changing_match_data)
-                            ? &search_regs : NULL),
+                           (modify_match_data ? &search_regs : NULL),
                            (!NILP (BVAR (current_buffer, case_fold_search))
                             ? BVAR (current_buffer, case_canon_table) : Qnil),
                            posix,
@@ -410,18 +411,17 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
   val = re_search (bufp, SSDATA (string),
 		   SBYTES (string), pos_byte,
 		   SBYTES (string) - pos_byte,
-		   (NILP (Vinhibit_changing_match_data)
-		    ? &search_regs : NULL));
+		   (modify_match_data ? &search_regs : NULL));
 
   /* Set last_thing_searched only when match data is changed.  */
-  if (NILP (Vinhibit_changing_match_data))
+  if (modify_match_data)
     last_thing_searched = Qt;
 
   if (val == -2)
     matcher_overflow ();
   if (val < 0) return Qnil;
 
-  if (NILP (Vinhibit_changing_match_data))
+  if (modify_match_data)
     for (i = 0; i < search_regs.num_regs; i++)
       if (search_regs.start[i] >= 0)
 	{
@@ -434,32 +434,42 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
   return make_fixnum (string_byte_to_char (string, val));
 }
 
-DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
+DEFUN ("string-match", Fstring_match, Sstring_match, 2, 4, 0,
        doc: /* Return index of start of first match for REGEXP in STRING, or nil.
 Matching ignores case if `case-fold-search' is non-nil.
 If third arg START is non-nil, start search at that index in STRING.
-For index of first char beyond the match, do (match-end 0).
-`match-end' and `match-beginning' also give indices of substrings
-matched by parenthesis constructs in the pattern.
 
-You can use the function `match-string' to extract the substrings
-matched by the parenthesis constructions in REGEXP. */)
-  (Lisp_Object regexp, Lisp_Object string, Lisp_Object start)
+If INHIBIT-MODIFY is non-nil, match data is not changed.
+
+If INHIBIT-MODIFY is nil or missing, match data is changed, and
+`match-end' and `match-beginning' give indices of substrings matched
+by parenthesis constructs in the pattern.  You can use the function
+`match-string' to extract the substrings matched by the parenthesis
+constructions in REGEXP.  For index of first char beyond the match, do
+(match-end 0).  */)
+  (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
+   Lisp_Object inhibit_modify)
 {
-  return string_match_1 (regexp, string, start, 0);
+  return string_match_1 (regexp, string, start, 0, NILP (inhibit_modify));
 }
 
-DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
+DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 4, 0,
        doc: /* Return index of start of first match for Posix REGEXP in STRING, or nil.
 Find the longest match, in accord with Posix regular expression rules.
 Case is ignored if `case-fold-search' is non-nil in the current buffer.
-If third arg START is non-nil, start search at that index in STRING.
-For index of first char beyond the match, do (match-end 0).
-`match-end' and `match-beginning' also give indices of substrings
-matched by parenthesis constructs in the pattern.  */)
-  (Lisp_Object regexp, Lisp_Object string, Lisp_Object start)
+
+If INHIBIT-MODIFY is non-nil, match data is not changed.
+
+If INHIBIT-MODIFY is nil or missing, match data is changed, and
+`match-end' and `match-beginning' give indices of substrings matched
+by parenthesis constructs in the pattern.  You can use the function
+`match-string' to extract the substrings matched by the parenthesis
+constructions in REGEXP.  For index of first char beyond the match, do
+(match-end 0).  */)
+  (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
+   Lisp_Object inhibit_modify)
 {
-  return string_match_1 (regexp, string, start, 1);
+  return string_match_1 (regexp, string, start, 1, NILP (inhibit_modify));
 }
 
 /* Match REGEXP against STRING using translation table TABLE,

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