Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs

2 files changed, 35 insertions, 21 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 2b5eb34e571..5cff86784f0 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3402,8 +3402,8 @@ lambda-expression."
 				       (t "."))))
           (let ((mutargs (function-get (car form) 'mutates-arguments)))
             (when mutargs
-              (dolist (idx (if (eq mutargs 'all-but-last)
-                               (number-sequence 1 (- (length form) 2))
+              (dolist (idx (if (symbolp mutargs)
+                               (funcall mutargs form)
                              mutargs))
                 (let ((arg (nth idx form)))
                   (when (and (or (and (eq (car-safe arg) 'quote)
@@ -3472,13 +3472,15 @@ lambda-expression."
       (if byte-compile--for-effect
           (byte-compile-discard)))))
 
+(defun bytecomp--sort-call-in-place-p (form)
+  (or (= (length form) 3)                  ; old-style
+      (plist-get (cddr form) :in-place)))  ; new-style
+
 (defun bytecomp--actually-important-return-value-p (form)
   "Whether FORM is really a call with a return value that should not go unused.
 This assumes the function has the `important-return-value' property."
   (cond ((eq (car form) 'sort)
-         ;; For `sort', we only care about non-destructive uses.
-         (and (zerop (% (length form) 2))  ; new-style call
-              (not (plist-get (cddr form) :in-place))))
+         (not (bytecomp--sort-call-in-place-p form)))
         (t t)))
 
 (let ((important-return-value-fns
@@ -3504,18 +3506,27 @@ This assumes the function has the `important-return-value' property."
   (dolist (fn important-return-value-fns)
     (put fn 'important-return-value t)))
 
+(defun bytecomp--mutargs-nconc (form)
+  ;; For `nconc', all arguments but the last are mutated.
+  (number-sequence 1 (- (length form) 2)))
+
+(defun bytecomp--mutargs-sort (form)
+  ;; For `sort', the first argument is mutated if the call is in-place.
+  (and (bytecomp--sort-call-in-place-p form) '(1)))
+
 (let ((mutating-fns
        ;; FIXME: Should there be a function declaration for this?
        ;;
        ;; (FUNC . ARGS) means that FUNC mutates arguments whose indices are
-       ;; in the list ARGS, starting at 1, or all but the last argument if
-       ;; ARGS is `all-but-last'.
+       ;; in the list ARGS, starting at 1.  ARGS can also be a function
+       ;; taking the function call form as argument and returning the
+       ;; list of indices.
        '(
          (setcar 1) (setcdr 1) (aset 1)
          (nreverse 1)
-         (nconc . all-but-last)
+         (nconc . bytecomp--mutargs-nconc)
          (nbutlast 1) (ntake 2)
-         (sort 1)
+         (sort  . bytecomp--mutargs-sort)
          (delq 2) (delete 2)
          (delete-dups 1) (delete-consecutive-dups 1)
          (plist-put 1)
diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index e77c8945dc3..c6fd65e1507 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -40,31 +40,34 @@
 (require 'pcase)
 
 (defconst ert-font-lock--face-symbol-re
-  (rx (one-or-more (or alphanumeric "-" "_" ".")))
-  "A face symbol matching regex.")
+  (rx (+ (or alphanumeric "-" "_" "." "/")))
+  "A face symbol matching regex.
+The regexp cannot use character classes as these can be redefined by the
+major mode of the host language.")
 
 (defconst ert-font-lock--face-symbol-list-re
   (rx "("
       (* whitespace)
-      (one-or-more
-       (seq (regexp ert-font-lock--face-symbol-re)
-            (* whitespace)))
+      (? (regexp ert-font-lock--face-symbol-re))
+      (* (+ whitespace)
+         (regexp ert-font-lock--face-symbol-re))
+      (* whitespace)
       ")")
   "A face symbol list matching regex.")
 
 (defconst ert-font-lock--assertion-line-re
   (rx
    ;; leading column assertion (arrow/caret)
-   (group (or "^" "<-"))
-   (zero-or-more whitespace)
+   (group-n 1 (or "^" "<-"))
+   (* whitespace)
    ;; possible to have many carets on an assertion line
-   (group (zero-or-more (seq "^" (zero-or-more whitespace))))
+   (group-n 2 (* "^" (* whitespace)))
    ;; optional negation of the face specification
-   (group (optional "!"))
-   (zero-or-more whitespace)
+   (group-n 3 (optional "!"))
+   (* whitespace)
    ;; face symbol name or a list of symbols
-   (group (or (regexp ert-font-lock--face-symbol-re)
-              (regexp ert-font-lock--face-symbol-list-re))))
+   (group-n 4 (or (regexp ert-font-lock--face-symbol-re)
+                  (regexp ert-font-lock--face-symbol-list-re))))
   "An ert-font-lock assertion line regex.")
 
 (defun ert-font-lock--validate-major-mode (mode)