emacs-29 2b8796eea19: Fix rx wrong-code bug: ranges starting with ^

[Mattias Engdegård]

branch: emacs-29
commit 2b8796eea1979fe6891ab9d80cd126fe8980167a
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Fix rx wrong-code bug: ranges starting with ^
    
    (rx (in (?^ . ?a))) was incorrectly translated to "[^-a]".
    Change it so that we get "[_-a^]" instead.
    
    * lisp/emacs-lisp/rx.el (rx--generate-alt): Split ranges starting with
    `^` occurring first in a non-negated character alternative.
    * test/lisp/emacs-lisp/rx-tests.el (rx-any): Add and adapt tests.
    
    (cherry picked from commit 5f5d668ac7917d61e9366fe0c3efd7b542671c3d)
---
 lisp/emacs-lisp/rx.el            | 20 +++++++++++++-------
 test/lisp/emacs-lisp/rx-tests.el | 20 +++++++++++++++-----
 2 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 46f61c26bc4..30195cbae32 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -445,13 +445,19 @@ classes."
           (setcar dash-l ?.))                  ; Reduce --x to .-x
         (setq items (nconc items '((?- . ?-))))))
 
-    ;; Deal with leading ^ and range ^-x.
-    (when (and (consp (car items))
-               (eq (caar items) ?^)
-               (cdr items))
-      ;; Move ^ and ^-x to second place.
-      (setq items (cons (cadr items)
-                        (cons (car items) (cddr items)))))
+    ;; Deal with leading ^ and range ^-x in non-negated set.
+    (when (and (eq (car-safe (car items)) ?^)
+               (not negated))
+      (if (eq (cdar items) ?^)
+          ;; single leading ^
+          (when (cdr items)
+            ;; Move the ^ to second place.
+            (setq items (cons (cadr items)
+                              (cons (car items) (cddr items)))))
+        ;; Split ^-x to _-x^
+        (setq items (cons (cons ?_ (cdar items))
+                          (cons '(?^ . ?^)
+                                (cdr items))))))
 
     (cond
      ;; Empty set: if negated, any char, otherwise match-nothing.
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 028250b7352..9c8628a8f26 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -112,23 +112,33 @@
   (should (equal (rx (any "]" "^") (any "]" "-") (any "-" "^")
                      (not (any "]" "^")) (not (any "]" "-"))
                      (not (any "-" "^")))
-                 "[]^][]-][-^][^]^][^]-][^-^]"))
+                 "[]^][]-][-^][^]^][^]-][^^-]"))
   (should (equal (rx (any "]" "^" "-") (not (any "]" "^" "-")))
                  "[]^-][^]^-]"))
+  (should (equal (rx (any "^-f") (any "^-f" "-")
+                     (any "^-f" "z") (any "^-f" "z" "-"))
+                 "[_-f^][_-f^-][_-f^z][_-f^z-]"))
+  (should (equal (rx (not (any "^-f")) (not (any "^-f" "-"))
+                     (not (any "^-f" "z")) (not (any "^-f" "z" "-")))
+                 "[^^-f][^^-f-][^^-fz][^^-fz-]"))
+  (should (equal (rx (any "^-f" word) (any "^-f" "-" word))
+                 "[_-f^[:word:]][_-f^[:word:]-]"))
+  (should (equal (rx (not (any "^-f" word)) (not (any "^-f" "-" word)))
+                 "[^^-f[:word:]][^^-f[:word:]-]"))
   (should (equal (rx (any "-" ascii) (any "^" ascii) (any "]" ascii))
                  "[[:ascii:]-][[:ascii:]^][][:ascii:]]"))
   (should (equal (rx (not (any "-" ascii)) (not (any "^" ascii))
                      (not (any "]" ascii)))
-                 "[^[:ascii:]-][^[:ascii:]^][^][:ascii:]]"))
+                 "[^[:ascii:]-][^^[:ascii:]][^][:ascii:]]"))
   (should (equal (rx (any "-]" ascii) (any "^]" ascii) (any "-^" ascii))
                  "[][:ascii:]-][]^[:ascii:]][[:ascii:]^-]"))
   (should (equal (rx (not (any "-]" ascii)) (not (any "^]" ascii))
                      (not (any "-^" ascii)))
-                 "[^][:ascii:]-][^]^[:ascii:]][^[:ascii:]^-]"))
+                 "[^][:ascii:]-][^]^[:ascii:]][^^[:ascii:]-]"))
   (should (equal (rx (any "-]^" ascii) (not (any "-]^" ascii)))
                  "[]^[:ascii:]-][^]^[:ascii:]-]"))
   (should (equal (rx (any "^" lower upper) (not (any "^" lower upper)))
-                 "[[:lower:]^[:upper:]][^[:lower:]^[:upper:]]"))
+                 "[[:lower:]^[:upper:]][^^[:lower:][:upper:]]"))
   (should (equal (rx (any "-" lower upper) (not (any "-" lower upper)))
                  "[[:lower:][:upper:]-][^[:lower:][:upper:]-]"))
   (should (equal (rx (any "]" lower upper) (not (any "]" lower upper)))
@@ -143,7 +153,7 @@
                  "[]-a-][^]-a-]"))
   (should (equal (rx (any "--]") (not (any "--]"))
                      (any "-" "^-a") (not (any "-" "^-a")))
-                 "[].-\\-][^].-\\-][-^-a][^-^-a]"))
+                 "[].-\\-][^].-\\-][_-a^-][^^-a-]"))
   (should (equal (rx (not (any "!a" "0-8" digit nonascii)))
                  "[^!0-8a[:digit:][:nonascii:]]"))
   (should (equal (rx (any) (not (any)))