Merge 'master' into noverlay

1 files changed, 1257 insertions, 158 deletions

diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 30d2a4753cf..e7c308213e4 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1,6 +1,6 @@
-;;; bytecomp-tests.el
+;;; bytecomp-tests.el --- Tests for bytecomp.el  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2022 Free Software Foundation, Inc.
 
 ;; Author: Shigeru Fukaya <shigeru.fukaya@gmail.com>
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
@@ -26,10 +26,42 @@
 ;;; Commentary:
 
 (require 'ert)
+(require 'ert-x)
 (require 'cl-lib)
+(require 'subr-x)
+(require 'bytecomp)
 
 ;;; Code:
-(defconst byte-opt-testsuite-arith-data
+(defvar bytecomp-test-var nil)
+
+(defun bytecomp-test-get-var ()
+  bytecomp-test-var)
+
+(defun bytecomp-test-identity (x)
+  "Identity, but hidden from some optimizations."
+  x)
+
+(defmacro bytecomp-test-loop (outer1 outer2 inner1 inner2)
+  "Exercise constant propagation inside `while' loops.
+OUTER1, OUTER2, INNER1 and INNER2 are forms placed in the outer and
+inner loops respectively."
+  `(let ((x 1) (i 3) (res nil))
+     (while (> i 0)
+       (let ((y 2) (j 2))
+         (setq res (cons (list 'outer x y) res))
+         (while (> j 0)
+           (setq res (cons (list 'inner x y) res))
+           ,inner1
+           ,inner2
+           (setq j (1- j)))
+         ,outer1
+         ,outer2)
+       (setq i (1- i)))
+     res))
+
+(defvar bytecomp-tests--xx nil)
+
+(defconst bytecomp-tests--test-cases
   '(
     ;; some functional tests
     (let ((a most-positive-fixnum) (b 1) (c 1.0))  (+ a b c))
@@ -38,14 +70,18 @@
     (let ((a 3) (b 2) (c 1.0))                     (/ a b c))
     (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (+ a -1 b))
     (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (- a 1 (- b)))
-    ;; This fails.  Should it be a bug?
-    ;; (let ((a (expt 2 -1074)) (b 0.125))		   (* a 8 b))
+    (let ((a (expt 2 -1074)) (b 0.125))		   (* a 8 b))
     (let ((a 1.0))				   (* a 0))
     (let ((a 1.0))				   (* a 2.0 0))
     (let ((a 1.0))				   (/ 0 a))
     (let ((a 1.0))				   (/ 3 a 2))
     (let ((a most-positive-fixnum) (b 2.0))	   (* a 2 b))
     (let ((a 3) (b 2))				   (/ a b 1.0))
+    (let ((a -0.0)) (+ a))
+    (let ((a -0.0)) (- a))
+    (let ((a -0.0)) (* a))
+    (let ((a -0.0)) (min a))
+    (let ((a -0.0)) (max a))
     (/ 3 -1)
     (+ 4 3 2 1)
     (+ 4 3 2.0 1)
@@ -244,6 +280,9 @@
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 0))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 1))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c -1))
+
+    (let ((a t)) (logand 0 a))
+
     ;; Test switch bytecode
     (let ((a 3)) (cond ((eq a 1) 'one) ((eq a 2) 'two) ((eq a 3) 'three) (t t)))
     (let ((a 'three)) (cond ((eq a 'one) 1) ((eq a 2) 'two) ((eq a 'three) 3)
@@ -286,90 +325,449 @@
             (t)))
     (let ((a))
       (cond ((eq a 'foo) 'incorrect)
-            ('correct))))
-  "List of expression for test.
-Each element will be executed by interpreter and with
-bytecompiled code, and their results compared.")
+            ('correct)))
+    ;; Bug#31734
+    (let ((variable 0))
+      (cond
+       ((eq variable 'default)
+	(message "equal"))
+       (t
+	(message "not equal"))))
+    ;; Bug#35770
+    (let ((x 'a)) (cond ((eq x 'a) 'correct)
+                        ((eq x 'b) 'incorrect)
+                        ((eq x 'a) 'incorrect)
+                        ((eq x 'c) 'incorrect)))
+    (let ((x #x10000000000000000))
+      (cond ((eql x #x10000000000000000) 'correct)
+            ((eql x #x10000000000000001) 'incorrect)
+            ((eql x #x10000000000000000) 'incorrect)
+            ((eql x #x10000000000000002) 'incorrect)))
+    (let ((x "a")) (cond ((equal x "a") 'correct)
+                         ((equal x "b") 'incorrect)
+                         ((equal x "a") 'incorrect)
+                         ((equal x "c") 'incorrect)))
+    ;; Multi-value clauses
+    (mapcar (lambda (x) (cond ((eq x 'a) 11)
+                              ((memq x '(b a c d)) 22)
+                              ((eq x 'c) 33)
+                              ((eq x 'e) 44)
+                              ((memq x '(d f g)) 55)
+                              (t 99)))
+            '(a b c d e f g h))
+    (mapcar (lambda (x) (cond ((eql x 1) 11)
+                              ((memq x '(a b c)) 22)
+                              ((memql x '(2 1 4 1e-3)) 33)
+                              ((eq x 'd) 44)
+                              ((eql x #x10000000000000000))))
+            '(1 2 4 1e-3 a b c d 1.0 #x10000000000000000))
+    (mapcar (lambda (x) (cond ((eq x 'a) 11)
+                              ((memq x '(b d)) 22)
+                              ((equal x '(a . b)) 33)
+                              ((member x '(b c 1.5 2.5 "X" (d))) 44)
+                              ((eql x 3.14) 55)
+                              ((memql x '(9 0.5 1.5 q)) 66)
+                              (t 99)))
+            '(a b c d (d) (a . b) "X" 0.5 1.5 3.14 9 9.0))
+    ;; Multi-switch cond form
+    (mapcar (lambda (p) (let ((x (car p)) (y (cadr p)))
+                          (cond ((consp x) 11)
+                                ((eq x 'a) 22)
+                                ((memql x '(b 7 a -3)) 33)
+                                ((equal y "a") 44)
+                                ((memq y '(c d e)) 55)
+                                ((booleanp x) 66)
+                                ((eq x 'q) 77)
+                                ((memq x '(r s)) 88)
+                                ((eq x 't) 99)
+                                (t 999))))
+            '((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c)
+              (t c) (x "a") (x "c") (x c) (x d) (x e)))
 
-(defun bytecomp-check-1 (pat)
-  "Return non-nil if PAT is the same whether directly evalled or compiled."
-  (let ((warning-minimum-log-level :emergency)
-	(byte-compile-warnings nil)
-	(v0 (condition-case nil
-		(eval pat)
-	      (error nil)))
-	(v1 (condition-case nil
-		(funcall (byte-compile (list 'lambda nil pat)))
-	      (error nil))))
-    (equal v0 v1)))
-
-(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1)
-
-(defun bytecomp-explain-1 (pat)
-  (let ((v0 (condition-case nil
-		(eval pat)
-	      (error nil)))
-	(v1 (condition-case nil
-		(funcall (byte-compile (list 'lambda nil pat)))
-	      (error nil))))
-    (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
-	    pat v0 v1)))
-
-(ert-deftest bytecomp-tests ()
-  "Test the Emacs byte compiler."
-  (dolist (pat byte-opt-testsuite-arith-data)
-    (should (bytecomp-check-1 pat))))
-
-(defun test-byte-opt-arithmetic (&optional arg)
-  "Unit test for byte-opt arithmetic operations.
-Subtests signal errors if something goes wrong."
-  (interactive "P")
-  (switch-to-buffer (generate-new-buffer "*Font Pase Test*"))
+    (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1)
+                                             ((equal x '(c)) 2))))
+            '(((a . b)) a b (c) (d)))
+    (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1)
+                                             ((equal x '(c)) 2))))
+            '(((a . b)) a b (c) (d)))
+    (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1)
+                                             ((equal x '(c)) 2))))
+            '(((a b)) a b (c) (d)))
+    (mapcar (lambda (x) (ignore-errors (cond ((memq '(a b) x) 1)
+                                             ((equal x '(c)) 2))))
+            '(((a b)) a b (c) (d)))
+
+    (assoc 'b '((a 1) (b 2) (c 3)))
+    (assoc "b" '(("a" 1) ("b" 2) ("c" 3)))
+    (let ((x '((a 1) (b 2) (c 3)))) (assoc 'c x))
+    (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v))))
+
+    ;; Constprop test cases
+    (let ((a 'alpha) (b (concat "be" "ta")) (c nil) (d t) (e :gamma)
+          (f '(delta epsilon)))
+      (list a b c d e f))
+
+    (let ((x 1) (y (+ 3 4)))
+      (list
+       (let (q (y x) (z y))
+         (if q x (list x y z)))))
+
+    (let* ((x 3) (y (* x 2)) (x (1+ y)))
+      x)
+
+    (let ((x 1) (bytecomp-test-var 2) (y 3))
+      (list x bytecomp-test-var (bytecomp-test-get-var) y))
+
+    (progn
+      (defvar d)
+      (let ((x 'a) (y 'b)) (list x y)))
+
+    (let ((x 2))
+      (list x (setq x 13) (setq x (* x 2)) x))
+
+    (let ((x 'a) (y 'b))
+      (setq y x
+            x (cons 'c y)
+            y x)
+      (list x y))
+
+    (let ((x 3))
+      (let ((y x) z)
+        (setq x 5)
+        (setq y (+ y 8))
+        (setq z (if (bytecomp-test-identity t)
+                    (progn
+                      (setq x (+ x 1))
+                      (list x y))
+                  (setq x (+ x 2))
+                  (list x y)))
+        (list x y z)))
+
+    (let ((i 1) (s 0) (x 13))
+      (while (< i 5)
+        (setq s (+ s i))
+        (setq i (1+ i)))
+      (list s x i))
+
+    (let ((x 2))
+      (list (or (bytecomp-test-identity 'a) (setq x 3)) x))
+
+    (mapcar (lambda (b)
+              (let ((a nil))
+                (+ 0
+                   (progn
+                     (setq a b)
+                     (setq b 1)
+                     a))))
+            '(10))
+
+    (let* ((x 1)
+           (y (condition-case x
+                  (/ 1 0)
+                (arith-error x))))
+      (list x y))
+
+    (funcall
+     (condition-case x
+         (/ 1 0)
+       (arith-error (prog1 (lambda (y) (+ y x))
+                      (setq x 10))))
+     4)
+
+    ;; Loop constprop: set the inner and outer variables in the inner
+    ;; and outer loops, all combinations.
+    (bytecomp-test-loop nil        nil        nil        nil       )
+    (bytecomp-test-loop nil        nil        nil        (setq x 6))
+    (bytecomp-test-loop nil        nil        (setq x 5) nil       )
+    (bytecomp-test-loop nil        nil        (setq x 5) (setq x 6))
+    (bytecomp-test-loop nil        (setq x 4) nil        nil       )
+    (bytecomp-test-loop nil        (setq x 4) nil        (setq x 6))
+    (bytecomp-test-loop nil        (setq x 4) (setq x 5) nil       )
+    (bytecomp-test-loop nil        (setq x 4) (setq x 5) (setq x 6))
+    (bytecomp-test-loop (setq x 3) nil        nil        nil       )
+    (bytecomp-test-loop (setq x 3) nil        nil        (setq x 6))
+    (bytecomp-test-loop (setq x 3) nil        (setq x 5) nil       )
+    (bytecomp-test-loop (setq x 3) nil        (setq x 5) (setq x 6))
+    (bytecomp-test-loop (setq x 3) (setq x 4) nil        nil       )
+    (bytecomp-test-loop (setq x 3) (setq x 4) nil        (setq x 6))
+    (bytecomp-test-loop (setq x 3) (setq x 4) (setq x 5) nil       )
+    (bytecomp-test-loop (setq x 3) (setq x 4) (setq x 5) (setq x 6))
+
+    ;; No error, no success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x)))
+    ;; Error, no success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x)))
+    ;; No error, success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Error, success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Verify that the success code is not subject to the error handlers.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (/ (car x) 0)))
+    ;; Check variable scoping on success.
+    (let ((x 2))
+      (condition-case x
+          (list x)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check variable scoping on failure.
+    (let ((x 2))
+      (condition-case x
+          (/ 1 0)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check capture of mutated result variable.
+    (funcall
+     (condition-case x
+         3
+       (:success (prog1 (lambda (y) (+ y x))
+                   (setq x 10))))
+     4)
+    ;; Check for-effect context, on error.
+    (let ((f (lambda (x)
+               (condition-case nil
+                   (/ 1 0)
+                 (error 'bad)
+                 (:success 'good))
+               (1+ x))))
+      (funcall f 3))
+    ;; Check for-effect context, on success.
+    (let ((f (lambda (x)
+               (condition-case nil
+                   nil
+                 (error 'bad)
+                 (:success 'good))
+               (1+ x))))
+      (funcall f 3))
+
+    ;; Check `not' in cond switch (bug#49746).
+    (mapcar (lambda (x) (cond ((equal x "a") 1)
+                              ((member x '("b" "c")) 2)
+                              ((not x) 3)))
+            '("a" "b" "c" "d" nil))
+
+    ;; `let' and `let*' optimizations with body being constant or variable
+    (let* (a
+           (b (progn (setq a (cons 1 a)) 2))
+           (c (1+ b))
+           (d (list a c)))
+      d)
+    (let ((a nil))
+      (let ((b (progn (setq a (cons 1 a)) 2))
+            (c (progn (setq a (cons 3 a))))
+            (d (list a)))
+        d))
+    (let* ((_a 1)
+           (_b 2))
+      'z)
+    (let ((_a 1)
+          (_b 2))
+      'z)
+    (let (x y)
+      y)
+    (let* (x y)
+      y)
+    (let (x y)
+      'a)
+    (let* (x y)
+      'a)
+
+    ;; Check empty-list optimizations.
+    (mapcar (lambda (x) (member x nil)) '("a" 2 nil))
+    (mapcar (lambda (x) (memql x nil)) '(a 2 nil))
+    (mapcar (lambda (x) (memq x nil)) '(a nil))
+    (let ((n 0))
+      (list (mapcar (lambda (x) (member (setq n (1+ n)) nil)) '(a "nil"))
+            n))
+    (mapcar (lambda (x) (assoc x nil)) '("a" nil))
+    (mapcar (lambda (x) (assq x nil)) '(a nil))
+    (mapcar (lambda (x) (rassoc x nil)) '("a" nil))
+    (mapcar (lambda (x) (rassq x nil)) '(a nil))
+    (let ((n 0))
+      (list (mapcar (lambda (x) (assoc (setq n (1+ n)) nil)) '(a "nil"))
+            n))
+
+    ;; Exercise variable-aliasing optimizations.
+    (let ((a (list 1)))
+      (let ((b a))
+        (let ((a (list 2)))
+          (list a b))))
+
+    (let ((a (list 1)))
+      (let ((a (list 2))
+            (b a))
+        (list a b)))
+
+    (let* ((a (list 1))
+           (b a)
+           (a (list 2)))
+      (condition-case a
+          (list a b)
+        (error (list 'error a b))))
+
+    (let* ((a (list 1))
+           (b a)
+           (a (list 2)))
+      (condition-case a
+          (/ 0)
+        (error (list 'error a b))))
+
+    (let* ((a (list 1))
+           (b a)
+           (a (list 2))
+           (f (list (lambda (x) (list x a)))))
+      (funcall (car f) 3))
+
+    (let* ((a (list 1))
+           (b a)
+           (f (list (lambda (x) (setq a x)))))
+      (funcall (car f) 3)
+      (list a b))
+
+    (let* ((a (list 1))
+           (b a)
+           (a (list 2))
+           (f (list (lambda (x) (setq a x)))))
+      (funcall (car f) 3)
+      (list a b))
+
+    (cond)
+    (mapcar (lambda (x) (cond ((= x 0)))) '(0 1))
+
+    ;; These expressions give different results in lexbind and dynbind modes,
+    ;; but in each the compiler and interpreter should agree!
+    ;; (They look much the same but come in pairs exercising both the
+    ;; `let' and `let*' paths.)
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (let ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (let* ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (setq x (list x x))
+                   (let ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (setq x (list x x))
+                   (let* ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (let ((g (lambda () x))
+                     (h (lambda () (setq x (list x x)))))
+                 (let ((x 'a))
+                   (list x (funcall g) (funcall h)))))))
+      (funcall (funcall f 'b)))
+    (let ((f (lambda (x)
+               (let ((g (lambda () x))
+                     (h (lambda () (setq x (list x x)))))
+                 (let* ((x 'a))
+                   (list x (funcall g) (funcall h)))))))
+      (funcall (funcall f 'b)))
+
+    ;; Test constant-propagation of access to captured variables.
+    (let* ((x 2)
+           (f (lambda ()
+                (let ((y x)) (list y 3 y)))))
+      (funcall f))
+
+    ;; Test rewriting of `set' to `setq' (only done on dynamic variables).
+    (let ((xx 1)) (set 'xx 2) xx)
+    (let ((bytecomp-tests--xx 1))
+      (set 'bytecomp-tests--xx 2)
+      bytecomp-tests--xx)
+    (let ((aaa 1)) (set (make-local-variable 'aaa) 2) aaa)
+    (let ((bytecomp-tests--xx 1))
+      (set (make-local-variable 'bytecomp-tests--xx) 2)
+      bytecomp-tests--xx)
+    )
+  "List of expressions for cross-testing interpreted and compiled code.")
+
+(defconst bytecomp-tests--test-cases-lexbind-only
+  `(
+    ;; This would infloop (and exhaust stack) with dynamic binding.
+    (let ((f #'car))
+      (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
+        (funcall f '(1 . 2))))
+    )
+  "List of expressions for cross-testing interpreted and compiled code.
+These are only tested with lexical binding.")
+
+(defun bytecomp-tests--eval-interpreted (form)
+  "Evaluate FORM using the Lisp interpreter, returning errors as a
+special value."
+  (condition-case err
+      (eval form lexical-binding)
+    (error (list 'bytecomp-check-error (car err)))))
+
+(defun bytecomp-tests--eval-compiled (form)
+  "Evaluate FORM using the Lisp byte-code compiler, returning errors as a
+special value."
   (let ((warning-minimum-log-level :emergency)
-	(byte-compile-warnings nil)
-	(pass-face '((t :foreground "green")))
-	(fail-face '((t :foreground "red")))
-	(print-escape-nonascii t)
-	(print-escape-newlines t)
-	(print-quoted t)
-	v0 v1)
-    (dolist (pat byte-opt-testsuite-arith-data)
-      (condition-case nil
-	  (setq v0 (eval pat))
-	(error (setq v0 nil)))
-      (condition-case nil
-	  (setq v1 (funcall (byte-compile (list 'lambda nil pat))))
-	(error (setq v1 nil)))
-      (insert (format "%s" pat))
-      (indent-to-column 65)
-      (if (equal v0 v1)
-	  (insert (propertize "OK" 'face pass-face))
-	(insert (propertize "FAIL\n" 'face fail-face))
-	(indent-to-column 55)
-	(insert (propertize (format "[%s] vs [%s]" v0 v1)
-			    'face fail-face)))
-      (insert "\n"))))
+        (byte-compile-warnings nil))
+    (condition-case err
+	(funcall (byte-compile (list 'lambda nil form)))
+      (error (list 'bytecomp-check-error (car err))))))
+
+(ert-deftest bytecomp-tests-lexbind ()
+  "Check that various expressions behave the same when interpreted and
+byte-compiled.  Run with lexical binding."
+  (let ((lexical-binding t))
+    (dolist (form (append bytecomp-tests--test-cases-lexbind-only
+                          bytecomp-tests--test-cases))
+      (ert-info ((prin1-to-string form) :prefix "form: ")
+        (should (equal (bytecomp-tests--eval-interpreted form)
+                       (bytecomp-tests--eval-compiled form)))))))
+
+(ert-deftest bytecomp-tests-dynbind ()
+  "Check that various expressions behave the same when interpreted and
+byte-compiled.  Run with dynamic binding."
+  (let ((lexical-binding nil))
+    (dolist (form bytecomp-tests--test-cases)
+      (ert-info ((prin1-to-string form) :prefix "form: ")
+        (should (equal (bytecomp-tests--eval-interpreted form)
+                       (bytecomp-tests--eval-compiled form)))))))
 
 (defun test-byte-comp-compile-and-load (compile &rest forms)
-  (let ((elfile nil)
-        (elcfile nil))
-    (unwind-protect
-         (progn
-           (setf elfile (make-temp-file "test-bytecomp" nil ".el"))
-           (when compile
-             (setf elcfile (make-temp-file "test-bytecomp" nil ".elc")))
-           (with-temp-buffer
-             (dolist (form forms)
-               (print form (current-buffer)))
-             (write-region (point-min) (point-max) elfile nil 'silent))
-           (if compile
-               (let ((byte-compile-dest-file-function
-                      (lambda (e) elcfile)))
-                 (byte-compile-file elfile t))
-             (load elfile nil 'nomessage)))
-      (when elfile (delete-file elfile))
-      (when elcfile (delete-file elcfile)))))
-(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1)
+  (declare (indent 1))
+  (ert-with-temp-file elfile
+    :suffix ".el"
+    (ert-with-temp-file elcfile
+      :suffix ".elc"
+      (with-temp-buffer
+        (insert ";;; -*- lexical-binding: t -*-\n")
+        (dolist (form forms)
+          (print form (current-buffer)))
+        (write-region (point-min) (point-max) elfile nil 'silent))
+      (if compile
+          (let ((byte-compile-dest-file-function
+                 (lambda (e) elcfile)))
+            (byte-compile-file elfile)))
+      (load elfile nil 'nomessage))))
 
 (ert-deftest test-byte-comp-macro-expansion ()
   (test-byte-comp-compile-and-load t
@@ -405,9 +803,13 @@ Subtests signal errors if something goes wrong."
       (defun def () (m))))
   (should (equal (funcall 'def) 4)))
 
+
+;;;; Warnings.
+
 (ert-deftest bytecomp-tests--warnings ()
   (with-current-buffer (get-buffer-create "*Compile-Log*")
     (let ((inhibit-read-only t)) (erase-buffer)))
+  (mapc #'fmakunbound '(my-test0 my--test11 my--test12 my--test2))
   (test-byte-comp-compile-and-load t
     '(progn
        (defun my-test0 ()
@@ -431,6 +833,219 @@ Subtests signal errors if something goes wrong."
     ;; Should not warn that mt--test2 is not known to be defined.
     (should-not (re-search-forward "my--test2" nil t))))
 
+(defmacro bytecomp--with-warning-test (re-warning &rest form)
+  (declare (indent 1))
+  `(with-current-buffer (get-buffer-create "*Compile-Log*")
+     (let ((inhibit-read-only t)) (erase-buffer))
+     (byte-compile ,@form)
+     (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ")
+       (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning))))))
+
+(ert-deftest bytecomp-warn-wrong-args ()
+  (bytecomp--with-warning-test "remq.*3.*2"
+    '(remq 1 2 3)))
+
+(ert-deftest bytecomp-warn-wrong-args-subr ()
+  (bytecomp--with-warning-test "safe-length.*3.*1"
+    '(safe-length 1 2 3)))
+
+(ert-deftest bytecomp-warn-variable-lacks-prefix ()
+  (bytecomp--with-warning-test "foo.*lacks a prefix"
+    '(defvar foo nil)))
+
+(defvar bytecomp-tests--docstring (make-string 100 ?x))
+
+(ert-deftest bytecomp-warn-wide-docstring/defconst ()
+  (bytecomp--with-warning-test "defconst.*foo.*wider than.*characters"
+    `(defconst foo t ,bytecomp-tests--docstring)))
+
+(ert-deftest bytecomp-warn-wide-docstring/defvar ()
+  (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters"
+    `(defvar foo t ,bytecomp-tests--docstring)))
+
+(defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse)
+  `(ert-deftest ,(intern (format "bytecomp/%s" file)) ()
+     (with-current-buffer (get-buffer-create "*Compile-Log*")
+       (let ((inhibit-read-only t)) (erase-buffer))
+       (byte-compile-file ,(ert-resource-file file))
+       (ert-info ((buffer-string) :prefix "buffer: ")
+         (,(if reverse 'should-not 'should)
+          (re-search-forward ,re-warning nil t))))))
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el"
+                            "add-hook.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-remove-hook.el"
+                            "remove-hook.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-run-hook-with-args-until-failure.el"
+                            "args-until-failure.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-run-hook-with-args-until-success.el"
+                            "args-until-success.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-run-hook-with-args.el"
+                            "args.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-symbol-value.el"
+                            "symbol-value.*lexical var")
+
+(bytecomp--define-warning-file-test "warn-autoload-not-on-top-level.el"
+                            "compiler ignores.*autoload.*")
+
+(bytecomp--define-warning-file-test "warn-callargs.el"
+                            "with 2 arguments, but accepts only 1")
+
+(bytecomp--define-warning-file-test "warn-callargs-defsubst.el"
+                            "with 2 arguments, but accepts only 1")
+
+(bytecomp--define-warning-file-test "warn-defcustom-nogroup.el"
+                            "fails to specify containing group")
+
+(bytecomp--define-warning-file-test "warn-defcustom-notype.el"
+                            "fails to specify type")
+
+(bytecomp--define-warning-file-test "warn-defvar-lacks-prefix.el"
+                            "var.*foo.*lacks a prefix")
+
+(bytecomp--define-warning-file-test "warn-format.el"
+                            "called with 2 args to fill 1 format field")
+
+(bytecomp--define-warning-file-test "warn-free-setq.el"
+                            "free.*foo")
+
+(bytecomp--define-warning-file-test "warn-free-variable-reference.el"
+                            "free variable .bar")
+
+(bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el"
+                            "make-variable-buffer-local. not called at toplevel")
+
+(bytecomp--define-warning-file-test "warn-interactive-only.el"
+                            "next-line.*interactive use only.*forward-line")
+
+(bytecomp--define-warning-file-test "warn-lambda-malformed-interactive-spec.el"
+                            "malformed .interactive. specification")
+
+(bytecomp--define-warning-file-test "warn-obsolete-defun.el"
+  "foo-obsolete. is an obsolete function (as of 99.99)")
+
+(defvar bytecomp--tests-obsolete-var nil)
+(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99")
+
+(bytecomp--define-warning-file-test "warn-obsolete-hook.el"
+  "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
+
+(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el"
+                            "foo-obs.*obsolete.*99.99" t)
+
+(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
+  "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
+
+(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
+                            "bytecomp--tests-obs.*obsolete.*99.99" t)
+
+(bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el"
+                            "as both function and macro")
+
+(bytecomp--define-warning-file-test "warn-redefine-macro-as-defun.el"
+                            "as both function and macro")
+
+(bytecomp--define-warning-file-test "warn-redefine-defun.el"
+                            "defined multiple")
+
+(bytecomp--define-warning-file-test "warn-save-excursion.el"
+                            "with-current.*rather than save-excursion")
+
+(bytecomp--define-warning-file-test "warn-variable-let-bind-constant.el"
+                            "let-bind constant")
+
+(bytecomp--define-warning-file-test "warn-variable-let-bind-nonvariable.el"
+                            "let-bind nonvariable")
+
+(bytecomp--define-warning-file-test "warn-variable-set-constant.el"
+                            "attempt to set constant")
+
+(bytecomp--define-warning-file-test "warn-variable-setq-nonvariable.el"
+                            "attempt to set non-variable")
+
+(bytecomp--define-warning-file-test "warn-variable-setq-odd.el"
+                            "odd number of arguments")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-autoload.el"
+ "autoload .foox. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-custom-declare-variable.el"
+ "custom-declare-variable .foo. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defalias.el"
+ "defalias .foo. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defconst.el"
+ "defconst .foo-bar. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-define-abbrev-table.el"
+ "define-abbrev-table .foo. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-define-obsolete-function-alias.el"
+ "defalias .foo. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-define-obsolete-variable-alias.el"
+ "defvaralias .foo. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defun.el"
+ "Warning: docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defvar.el"
+ "defvar .foo-bar. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defvaralias.el"
+ "defvaralias .foo-bar. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-fill-column.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-function-signature.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-override.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-substitutions.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-multiline-first.el"
+ "defvar .foo-bar. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-multiline.el"
+ "defvar .foo-bar. docstring wider than .* characters")
+
+(bytecomp--define-warning-file-test
+ "nowarn-inline-after-defvar.el"
+ "Lexical argument shadows" 'reverse)
+
+
+;;;; Macro expansion.
+
 (ert-deftest test-eager-load-macro-expansion ()
   (test-byte-comp-compile-and-load nil
     '(progn (defmacro abc (arg) 1) (defun def () (abc 2))))
@@ -465,54 +1080,12 @@ Subtests signal errors if something goes wrong."
       (defun def () (m))))
   (should (equal (funcall 'def) 4)))
 
-(defconst bytecomp-lexbind-tests
-  `(
-    (let ((f #'car))
-      (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
-        (funcall f '(1 . 2))))
-    )
-  "List of expression for test.
-Each element will be executed by interpreter and with
-bytecompiled code, and their results compared.")
-
-(defun bytecomp-lexbind-check-1 (pat)
-  "Return non-nil if PAT is the same whether directly evalled or compiled."
-  (let ((warning-minimum-log-level :emergency)
-	(byte-compile-warnings nil)
-	(v0 (condition-case nil
-		(eval pat t)
-	      (error nil)))
-	(v1 (condition-case nil
-		(funcall (let ((lexical-binding t))
-                           (byte-compile `(lambda nil ,pat))))
-	      (error nil))))
-    (equal v0 v1)))
-
-(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1)
-
-(defun bytecomp-lexbind-explain-1 (pat)
-  (let ((v0 (condition-case nil
-		(eval pat t)
-	      (error nil)))
-	(v1 (condition-case nil
-		(funcall (let ((lexical-binding t))
-                           (byte-compile (list 'lambda nil pat))))
-	      (error nil))))
-    (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
-	    pat v0 v1)))
-
-(ert-deftest bytecomp-lexbind-tests ()
-  "Test the Emacs byte compiler lexbind handling."
-  (dolist (pat bytecomp-lexbind-tests)
-    (should (bytecomp-lexbind-check-1 pat))))
-
 (defmacro bytecomp-tests--with-temp-file (file-name-var &rest body)
   (declare (indent 1))
   (cl-check-type file-name-var symbol)
-  `(let ((,file-name-var (make-temp-file "emacs")))
+  `(ert-with-temp-file ,file-name-var
      (unwind-protect
          (progn ,@body)
-       (delete-file ,file-name-var)
        (let ((elc (concat ,file-name-var ".elc")))
          (if (file-exists-p elc) (delete-file elc))))))
 
@@ -520,37 +1093,28 @@ bytecompiled code, and their results compared.")
   "Check that byte compiling warns about unescaped character
 literals (Bug#20852)."
   (should (boundp 'lread--unescaped-character-literals))
-  (bytecomp-tests--with-temp-file source
-    (write-region "(list ?) ?( ?; ?\" ?[ ?])" nil source)
-    (bytecomp-tests--with-temp-file destination
-      (let* ((byte-compile-dest-file-function (lambda (_) destination))
-            (byte-compile-error-on-warn t)
-            (byte-compile-debug t)
-            (err (should-error (byte-compile-file source))))
-        (should (equal (cdr err)
-                       (list (concat "unescaped character literals "
-                                     "`?\"', `?(', `?)', `?;', `?[', `?]' "
-                                     "detected!"))))))))
-
-(ert-deftest bytecomp-tests--old-style-backquotes ()
-  "Check that byte compiling warns about old-style backquotes."
-  (should (boundp 'lread--old-style-backquotes))
-  (bytecomp-tests--with-temp-file source
-    (write-region "(` (a b))" nil source)
-    (bytecomp-tests--with-temp-file destination
-      (let* ((byte-compile-dest-file-function (lambda (_) destination))
-            (byte-compile-error-on-warn t)
-            (byte-compile-debug t)
-            (err (should-error (byte-compile-file source))))
-        (should (equal (cdr err)
-                       (list "!! The file uses old-style backquotes !!
-This functionality has been obsolete for more than 10 years already
-and will be removed soon.  See (elisp)Backquote in the manual.")))))))
-
+  (let ((byte-compile-error-on-warn t)
+        (byte-compile-debug t))
+    (bytecomp-tests--with-temp-file source
+      (write-region "(list ?) ?( ?; ?\" ?[ ?])" nil source)
+      (bytecomp-tests--with-temp-file destination
+        (let* ((byte-compile-dest-file-function (lambda (_) destination))
+               (err (should-error (byte-compile-file source))))
+          (should (equal (cdr err)
+                         `(,(concat "unescaped character literals "
+                                    "`?\"', `?(', `?)', `?;', `?[', `?]' "
+                                    "detected, "
+                                    "`?\\\"', `?\\(', `?\\)', `?\\;', `?\\[', "
+                                    "`?\\]' expected!")))))))
+    ;; But don't warn in subsequent compilations (Bug#36068).
+    (bytecomp-tests--with-temp-file source
+      (write-region "(list 1 2 3)" nil source)
+      (bytecomp-tests--with-temp-file destination
+        (let ((byte-compile-dest-file-function (lambda (_) destination)))
+          (should (byte-compile-file source)))))))
 
 (ert-deftest bytecomp-tests-function-put ()
   "Check `function-put' operates during compilation."
-  (should (boundp 'lread--old-style-backquotes))
   (bytecomp-tests--with-temp-file source
     (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1)
                     (function-put 'bytecomp-tests--foo 'bar 2)
@@ -561,12 +1125,547 @@ and will be removed soon.  See (elisp)Backquote in the manual.")))))))
                     (setq bytecomp-tests--foobar (bytecomp-tests--foobar))))
       (print form (current-buffer)))
     (write-region (point-min) (point-max) source nil 'silent)
-    (byte-compile-file source t)
+    (byte-compile-file source)
+    (load source)
     (should (equal bytecomp-tests--foobar (cons 1 2)))))
 
+(ert-deftest bytecomp-tests--test-no-warnings-with-advice ()
+  (defun f ())
+  (define-advice f (:around (oldfun &rest args) test)
+    (apply oldfun args))
+  (with-current-buffer (get-buffer-create "*Compile-Log*")
+    (let ((inhibit-read-only t)) (erase-buffer)))
+  (test-byte-comp-compile-and-load t '(defun f ()))
+  (with-current-buffer (get-buffer-create "*Compile-Log*")
+    (goto-char (point-min))
+    (should-not (search-forward "Warning" nil t))))
+
+(ert-deftest bytecomp-test-featurep-warnings ()
+  (let ((byte-compile-log-buffer (generate-new-buffer " *Compile-Log*")))
+    (unwind-protect
+        (progn
+          (with-temp-buffer
+            (insert "\
+\(defun foo ()
+  (an-undefined-function))
+
+\(defun foo1 ()
+  (if (featurep 'xemacs)
+      (some-undefined-function-if)))
+
+\(defun foo2 ()
+  (and (featurep 'xemacs)
+      (some-undefined-function-and)))
+
+\(defun foo3 ()
+  (if (not (featurep 'emacs))
+      (some-undefined-function-not)))
+
+\(defun foo4 ()
+  (or (featurep 'emacs)
+      (some-undefined-function-or)))
+")
+            (byte-compile-from-buffer (current-buffer)))
+          (with-current-buffer byte-compile-log-buffer
+            (should (search-forward "an-undefined-function" nil t))
+            (should-not (search-forward "some-undefined-function" nil t))))
+      (if (buffer-live-p byte-compile-log-buffer)
+          (kill-buffer byte-compile-log-buffer)))))
+
+(ert-deftest bytecomp-test--switch-duplicates ()
+  "Check that duplicates in switches are eliminated correctly (bug#35770)."
+  :expected-result (if byte-compile-cond-use-jump-table :passed :failed)
+  (dolist (params
+           '(((lambda (x)
+                (cond ((eq x 'a) 111)
+                      ((eq x 'b) 222)
+                      ((eq x 'a) 333)
+                      ((eq x 'c) 444)))
+              (a b c)
+              string<)
+             ((lambda (x)
+                (cond ((eql x #x10000000000000000) 111)
+                      ((eql x #x10000000000000001) 222)
+                      ((eql x #x10000000000000000) 333)
+                      ((eql x #x10000000000000002) 444)))
+              (#x10000000000000000 #x10000000000000001 #x10000000000000002)
+              <)
+             ((lambda (x)
+                (cond ((equal x "a") 111)
+                      ((equal x "b") 222)
+                      ((equal x "a") 333)
+                      ((equal x "c") 444)))
+              ("a" "b" "c")
+              string<)))
+    (let* ((lisp (nth 0 params))
+           (keys (nth 1 params))
+           (lessp (nth 2 params))
+           (bc (byte-compile lisp))
+           (lap (byte-decompile-bytecode (aref bc 1) (aref bc 2)))
+           ;; Assume the first constant is the switch table.
+           (table (cadr (assq 'byte-constant lap))))
+      (should (hash-table-p table))
+      (should (equal (sort (hash-table-keys table) lessp) keys))
+      (should (member '(byte-constant 111) lap))
+      (should (member '(byte-constant 222) lap))
+      (should-not (member '(byte-constant 333) lap))
+      (should (member '(byte-constant 444) lap)))))
+
+(defun test-suppression (form suppress match)
+  (let ((lexical-binding t)
+        (byte-compile-log-buffer (generate-new-buffer " *Compile-Log*")))
+    ;; Check that we get a warning without suppression.
+    (with-current-buffer byte-compile-log-buffer
+      (setq-local fill-column 9999)
+      (setq-local warning-fill-column fill-column)
+      (let ((inhibit-read-only t))
+        (erase-buffer)))
+    (test-byte-comp-compile-and-load t form)
+    (with-current-buffer byte-compile-log-buffer
+      (unless match
+        (error "%s" (buffer-string)))
+      (goto-char (point-min))
+      (should (string-match match (buffer-string))))
+    ;; And that it's gone now.
+    (with-current-buffer byte-compile-log-buffer
+      (let ((inhibit-read-only t))
+        (erase-buffer)))
+    (test-byte-comp-compile-and-load t
+     `(with-suppressed-warnings ,suppress
+        ,form))
+    (with-current-buffer byte-compile-log-buffer
+      (goto-char (point-min))
+      (should-not (string-match match (buffer-string))))
+    ;; Also check that byte compiled forms are identical.
+    (should (equal (byte-compile form)
+                   (byte-compile
+                    `(with-suppressed-warnings ,suppress ,form))))))
+
+(ert-deftest bytecomp-test--with-suppressed-warnings ()
+  (test-suppression
+   '(defvar prefixless)
+   '((lexical prefixless))
+   "global/dynamic var .prefixless. lacks")
+
+  ;; FIXME: These messages cannot be suppressed reliably right now,
+  ;; but attempting mutate `nil' or `5' is a rather daft thing to do
+  ;; in the first place.  Preventing mutation of constants such as
+  ;; `most-positive-fixnum' makes more sense but the compiler doesn't
+  ;; warn about that at all right now (it's caught at runtime, and we
+  ;; allow writing the same value).
+  ;;
+  ;; (test-suppression
+  ;;  '(defun foo()
+  ;;     (let ((nil t))
+  ;;       (message-mail)))
+  ;;  '((constants nil))
+  ;;  "Warning: attempt to let-bind constant .nil.")
+
+  (test-suppression
+   '(progn
+      (defun obsolete ()
+        (declare (obsolete foo "22.1")))
+      (defun zot ()
+        (obsolete)))
+   '((obsolete obsolete))
+   "Warning: .obsolete. is an obsolete function")
+
+  (test-suppression
+   '(progn
+      (defun wrong-params (foo &optional unused)
+        (ignore unused)
+        foo)
+      (defun zot ()
+        (wrong-params 1 2 3)))
+   '((callargs wrong-params))
+   "Warning: .wrong-params. called with")
+
+  (test-byte-comp-compile-and-load nil
+    (defvar obsolete-variable nil)
+    (make-obsolete-variable 'obsolete-variable nil "24.1"))
+  (test-suppression
+   '(defun zot ()
+      obsolete-variable)
+   '((obsolete obsolete-variable))
+   "obsolete")
+
+  (test-suppression
+   '(defun zot ()
+      (next-line))
+   '((interactive-only next-line))
+   "interactive use only")
+
+  (test-suppression
+   '(defun zot ()
+      (mapcar #'list '(1 2 3))
+      nil)
+   '((mapcar mapcar))
+   "Warning: .mapcar. called for effect")
+
+  (test-suppression
+   '(defun zot ()
+      free-variable)
+   '((free-vars free-variable))
+   "Warning: reference to free variable")
+
+  (test-suppression
+   '(defun zot ()
+      (save-excursion
+        (set-buffer (get-buffer-create "foo"))
+        nil))
+   '((suspicious set-buffer))
+   "Warning: Use .with-current-buffer. rather than"))
+
+(ert-deftest bytecomp-tests--not-writable-directory ()
+  "Test that byte compilation works if the output directory isn't
+writable (Bug#44631)."
+  (ert-with-temp-directory directory
+    (let* ((input-file (expand-file-name "test.el" directory))
+           (output-file (expand-file-name "test.elc" directory))
+           (byte-compile-dest-file-function
+            (lambda (_) output-file))
+           (byte-compile-error-on-warn t))
+      (unwind-protect
+          (progn
+            (write-region "" nil input-file nil nil nil 'excl)
+            (write-region "" nil output-file nil nil nil 'excl)
+            (set-file-modes input-file #o400)
+            (set-file-modes output-file #o200)
+            (set-file-modes directory #o500)
+            (should (byte-compile-file input-file))
+            (should (file-regular-p output-file))
+            (should (cl-plusp (file-attribute-size
+                               (file-attributes output-file)))))
+        ;; Allow the directory to be deleted.
+        (set-file-modes directory #o777)))))
+
+(ert-deftest bytecomp-tests--dest-mountpoint ()
+  "Test that byte compilation works if the destination file is a
+mountpoint (Bug#44631)."
+  (let ((bwrap (executable-find "bwrap"))
+        (emacs (expand-file-name invocation-name invocation-directory)))
+    (skip-unless bwrap)
+    (skip-unless (file-executable-p bwrap))
+    (skip-unless (not (file-remote-p bwrap)))
+    (skip-unless (file-executable-p emacs))
+    (skip-unless (not (file-remote-p emacs)))
+    (ert-with-temp-directory directory
+      (let* ((input-file (expand-file-name "test.el" directory))
+             (output-file (expand-file-name "test.elc" directory))
+             (unquoted-file (file-name-unquote output-file))
+             (byte-compile-dest-file-function
+              (lambda (_) output-file))
+             (byte-compile-error-on-warn t))
+        (should-not (file-remote-p input-file))
+        (should-not (file-remote-p output-file))
+        (write-region "" nil input-file nil nil nil 'excl)
+        (write-region "" nil output-file nil nil nil 'excl)
+        (unwind-protect
+            (progn
+              (set-file-modes input-file #o400)
+              (set-file-modes output-file #o200)
+              (set-file-modes directory #o500)
+              (with-temp-buffer
+                (let ((status (call-process
+                               bwrap nil t nil
+                               "--ro-bind" "/" "/"
+                               "--bind" unquoted-file unquoted-file
+                               emacs "--quick" "--batch" "--load=bytecomp"
+                               (format "--eval=%S"
+                                       `(setq byte-compile-dest-file-function
+                                              (lambda (_) ,output-file)
+                                              byte-compile-error-on-warn t))
+                               "--funcall=batch-byte-compile" input-file)))
+                  (unless (eql status 0)
+                    (ert-fail `((status . ,status)
+                                (output . ,(buffer-string)))))))
+              (should (file-regular-p output-file))
+              (should (cl-plusp (file-attribute-size
+                                 (file-attributes output-file)))))
+          ;; Allow the directory to be deleted.
+          (set-file-modes directory #o777))))))
+
+(ert-deftest bytecomp-tests--target-file-no-directory ()
+  "Check that Bug#45287 is fixed."
+  (ert-with-temp-directory directory
+    (let* ((default-directory directory)
+           (byte-compile-dest-file-function (lambda (_) "test.elc"))
+           (byte-compile-error-on-warn t))
+      (write-region "" nil "test.el" nil nil nil 'excl)
+      (should (byte-compile-file "test.el"))
+      (should (file-regular-p "test.elc"))
+      (should (cl-plusp (file-attribute-size
+                         (file-attributes "test.elc")))))))
+
+(defun bytecomp-tests--get-vars ()
+  (list (ignore-errors (symbol-value 'bytecomp-tests--var1))
+        (ignore-errors (symbol-value 'bytecomp-tests--var2))))
+
+(ert-deftest bytecomp-local-defvar ()
+  "Check that local `defvar' declarations work correctly, both
+interpreted and compiled."
+  (let ((lexical-binding t))
+    (let ((fun '(lambda ()
+                  (defvar bytecomp-tests--var1)
+                  (let ((bytecomp-tests--var1 'a)    ; dynamic
+                        (bytecomp-tests--var2 'b))   ; still lexical
+                    (ignore bytecomp-tests--var2)    ; avoid warning
+                    (bytecomp-tests--get-vars)))))
+      (should (listp fun))      ; Guard against overzealous refactoring!
+      (should (equal (funcall (eval fun t)) '(a nil)))
+      (should (equal (funcall (byte-compile fun)) '(a nil)))
+      )
+
+    ;; `progn' does not constitute a lexical scope for `defvar' (bug#46387).
+    (let ((fun '(lambda ()
+                  (progn
+                    (defvar bytecomp-tests--var1)
+                    (defvar bytecomp-tests--var2))
+                  (let ((bytecomp-tests--var1 'c)
+                        (bytecomp-tests--var2 'd))
+                    (bytecomp-tests--get-vars)))))
+      (should (listp fun))
+      (should (equal (funcall (eval fun t)) '(c d)))
+      (should (equal (funcall (byte-compile fun)) '(c d))))))
+
+(ert-deftest bytecomp-reify-function ()
+  "Check that closures that modify their bound variables are
+compiled correctly."
+  (cl-letf ((lexical-binding t)
+            ((symbol-function 'counter) nil))
+    (let ((x 0))
+      (defun counter () (cl-incf x))
+      (should (equal (counter) 1))
+      (should (equal (counter) 2))
+      ;; byte compiling should not cause counter to always return the
+      ;; same value (bug#46834)
+      (byte-compile 'counter)
+      (should (equal (counter) 3))
+      (should (equal (counter) 4)))
+    (let ((x 0))
+      (let ((x 1))
+        (defun counter () x)
+        (should (equal (counter) 1))
+        ;; byte compiling should not cause the outer binding to shadow
+        ;; the inner one (bug#46834)
+        (byte-compile 'counter)
+        (should (equal (counter) 1))))))
+
+(ert-deftest bytecomp-string-vs-docstring ()
+  ;; Don't confuse a string return value for a docstring.
+  (let ((lexical-binding t))
+    (should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy) "foo"))))
+
+(ert-deftest bytecomp-condition-case-success ()
+  ;; No error, no success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x)))
+                 '(42)))
+  ;; Error, no success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x)))
+                 '(bad arith-error)))
+  ;; No error, success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(good 42)))
+  ;; Error, success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(bad arith-error)))
+  ;; Verify that the success code is not subject to the error handlers.
+  (should-error (condition-case x
+                    (list 42)
+                  (error (cons 'bad x))
+                  (:success (/ (car x) 0)))
+                :type 'arith-error)
+  ;; Check variable scoping.
+  (let ((x 2))
+    (should (equal (condition-case x
+                       (list x)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(good (2))))
+    (should (equal (condition-case x
+                       (/ 1 0)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(bad (arith-error)))))
+  ;; Check capture of mutated result variable.
+  (should (equal (funcall
+                  (condition-case x
+                      3
+                    (:success (prog1 (lambda (y) (+ y x))
+                                (setq x 10))))
+                  4)
+                 14))
+    ;; Check for-effect context, on error.
+  (should (equal (let ((f (lambda (x)
+                            (condition-case nil
+                                (/ 1 0)
+                              (error 'bad)
+                              (:success 'good))
+                            (1+ x))))
+                   (funcall f 3))
+                 4))
+  ;; Check for-effect context, on success.
+  (should (equal (let ((f (lambda (x)
+                            (condition-case nil
+                                nil
+                              (error 'bad)
+                              (:success 'good))
+                            (1+ x))))
+                   (funcall f 3))
+                 4)))
+
+(declare-function bc-test-alpha-f (ert-resource-file "bc-test-alpha.el"))
+
+(ert-deftest bytecomp-defsubst ()
+  ;; Check that lexical variables don't leak into inlined code.  See
+  ;; https://lists.gnu.org/archive/html/emacs-devel/2021-05/msg01227.html
+
+  ;; First, remove any trace of the functions and package defined:
+  (fmakunbound 'bc-test-alpha-f)
+  (fmakunbound 'bc-test-beta-f)
+  (setq features (delq 'bc-test-beta features))
+  ;; Byte-compile one file that uses a function from another file that isn't
+  ;; compiled.
+  (let ((file (ert-resource-file "bc-test-alpha.el"))
+        (load-path (cons (ert-resource-directory) load-path)))
+    (byte-compile-file file)
+    (load-file (concat file "c"))
+    (should (equal (bc-test-alpha-f 'a) '(nil a)))))
+
+(ert-deftest bytecomp-tests-byte-compile--wide-docstring-p/func-arg-list ()
+  (should-not (byte-compile--wide-docstring-p "\
+\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
+[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+(fn CMD FLAGS FIS &key (BUF (cvs-temp-buffer)) DONT-CHANGE-DISC CVSARGS \
+POSTPROC)" fill-column))
+  ;; Bug#49007
+  (should-not (byte-compile--wide-docstring-p "\
+(fn (THIS rudel-protocol-backend) TRANSPORT \
+INFO INFO-CALLBACK &optional PROGRESS-CALLBACK)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
+[:tags \\='(TAG...)] BODY...)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+(make-soap-xs-element &key NAME NAMESPACE-TAG ID TYPE^ OPTIONAL? MULTIPLE? \
+REFERENCE SUBSTITUTION-GROUP ALTERNATIVES IS-GROUP)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+(fn NAME FIXTURE INPUT &key SKIP-PAIR-STRING EXPECTED-STRING \
+EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
+(TEST-IN-COMMENTS t) (TEST-IN-STRINGS t) (TEST-IN-CODE t) \
+(FIXTURE-FN \\='#\\='electric-pair-mode))" fill-column)))
+
+(defun test-bytecomp-defgroup-choice ()
+  (should-not (byte-compile--suspicious-defcustom-choice 'integer))
+  (should-not (byte-compile--suspicious-defcustom-choice
+               '(choice (const :tag "foo" bar))))
+  (should (byte-compile--suspicious-defcustom-choice
+           '(choice (const :tag "foo" 'bar)))))
+
+(ert-deftest bytecomp-function-attributes ()
+  ;; Check that `byte-compile' keeps the declarations, interactive spec and
+  ;; doc string of the function (bug#55830).
+  (let ((fname 'bytecomp-test-fun))
+    (fset fname nil)
+    (put fname 'pure nil)
+    (put fname 'lisp-indent-function nil)
+    (eval `(defun ,fname (x)
+             "tata"
+             (declare (pure t) (indent 1))
+             (interactive "P")
+             (list 'toto x))
+          t)
+    (let ((bc (byte-compile fname)))
+      (should (byte-code-function-p bc))
+      (should (equal (funcall bc 'titi) '(toto titi)))
+      (should (equal (aref bc 5) "P"))
+      (should (equal (get fname 'pure) t))
+      (should (equal (get fname 'lisp-indent-function) 1))
+      (should (equal (aref bc 4) "tata\n\n(fn X)")))))
+
+(ert-deftest bytecomp-fun-attr-warn ()
+  ;; Check that warnings are emitted when doc strings, `declare' and
+  ;; `interactive' forms don't come in the proper order, or more than once.
+  (let* ((filename "fun-attr-warn.el")
+         (el (ert-resource-file filename))
+         (elc (concat el "c"))
+         (text-quoting-style 'grave))
+    (with-current-buffer (get-buffer-create "*Compile-Log*")
+      (let ((inhibit-read-only t))
+        (erase-buffer))
+      (byte-compile-file el)
+      (let ((expected
+             '("70:4: Warning: `declare' after `interactive'"
+               "74:4: Warning: Doc string after `interactive'"
+               "79:4: Warning: Doc string after `interactive'"
+               "84:4: Warning: Doc string after `declare'"
+               "89:4: Warning: Doc string after `declare'"
+               "96:4: Warning: `declare' after `interactive'"
+               "102:4: Warning: `declare' after `interactive'"
+               "108:4: Warning: `declare' after `interactive'"
+               "106:4: Warning: Doc string after `interactive'"
+               "114:4: Warning: `declare' after `interactive'"
+               "112:4: Warning: Doc string after `interactive'"
+               "118:4: Warning: Doc string after `interactive'"
+               "119:4: Warning: `declare' after `interactive'"
+               "124:4: Warning: Doc string after `interactive'"
+               "125:4: Warning: `declare' after `interactive'"
+               "130:4: Warning: Doc string after `declare'"
+               "136:4: Warning: Doc string after `declare'"
+               "142:4: Warning: Doc string after `declare'"
+               "148:4: Warning: Doc string after `declare'"
+               "159:4: Warning: More than one doc string"
+               "165:4: Warning: More than one doc string"
+               "171:4: Warning: More than one doc string"
+               "178:4: Warning: More than one doc string"
+               "186:4: Warning: More than one doc string"
+               "192:4: Warning: More than one doc string"
+               "200:4: Warning: More than one doc string"
+               "206:4: Warning: More than one doc string"
+               "215:4: Warning: More than one `declare' form"
+               "222:4: Warning: More than one `declare' form"
+               "230:4: Warning: More than one `declare' form"
+               "237:4: Warning: More than one `declare' form"
+               "244:4: Warning: More than one `interactive' form"
+               "251:4: Warning: More than one `interactive' form"
+               "258:4: Warning: More than one `interactive' form"
+               "257:4: Warning: `declare' after `interactive'"
+               "265:4: Warning: More than one `interactive' form"
+               "264:4: Warning: `declare' after `interactive'")))
+        (goto-char (point-min))
+        (let ((actual nil))
+          (while (re-search-forward
+                  (rx bol (* (not ":")) ":"
+                      (group (+ digit) ":" (+ digit) ": Warning: "
+                             (or "More than one " (+ nonl) " form"
+                                 (: (+ nonl) " after " (+ nonl))))
+                      eol)
+                  nil t)
+            (push (match-string 1) actual))
+          (setq actual (nreverse actual))
+          (should (equal actual expected)))))))
+
+(ert-deftest byte-compile-file/no-byte-compile ()
+  (let* ((src-file (ert-resource-file "no-byte-compile.el"))
+         (dest-file (make-temp-file "bytecomp-tests-" nil ".elc"))
+         (byte-compile-dest-file-function (lambda (_) dest-file)))
+    (should (eq (byte-compile-file src-file) 'no-byte-compile))
+    (should-not (file-exists-p dest-file))))
+
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
 
 (provide 'bytecomp-tests)
-;; bytecomp-tests.el ends here.
+;;; bytecomp-tests.el ends here