diff options
Diffstat (limited to 'test/lisp/emacs-lisp/bytecomp-tests.el')
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 351 |
1 files changed, 254 insertions, 97 deletions
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a97473e7de4..a246c25e24f 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -640,6 +640,58 @@ inner loops respectively." (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)) ) "List of expressions for cross-testing interpreted and compiled code.") @@ -690,24 +742,20 @@ byte-compiled. Run with dynamic binding." (defun test-byte-comp-compile-and-load (compile &rest forms) (declare (indent 1)) - (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))) - (load elfile nil 'nomessage)) - (when elfile (delete-file elfile)) - (when elcfile (delete-file elcfile))))) + (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 @@ -810,8 +858,7 @@ byte-compiled. Run with dynamic binding." (byte-compile-file ,(ert-resource-file file)) (ert-info ((buffer-string) :prefix "buffer: ") (,(if reverse 'should-not 'should) - (re-search-forward ,(string-replace " " "[ \n]+" re-warning) - nil t)))))) + (re-search-forward ,re-warning nil t)))))) (bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el" "add-hook.*lexical var") @@ -904,11 +951,17 @@ byte-compiled. Run with dynamic binding." "let-bind nonvariable") (bytecomp--define-warning-file-test "warn-variable-set-constant.el" - "variable reference to constant") + "attempt to set constant") (bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el" "variable reference to nonvariable") +(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") @@ -939,7 +992,7 @@ byte-compiled. Run with dynamic binding." (bytecomp--define-warning-file-test "warn-wide-docstring-defun.el" - "wider than .* characters") + "Warning: docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defvar.el" @@ -958,6 +1011,10 @@ byte-compiled. Run with dynamic binding." "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) @@ -1013,10 +1070,9 @@ byte-compiled. Run with dynamic binding." (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)))))) @@ -1178,12 +1234,19 @@ literals (Bug#20852)." '((lexical prefixless)) "global/dynamic var .prefixless. lacks") - (test-suppression - '(defun foo() - (let ((nil t)) - (message-mail))) - '((constants nil)) - "Warning: attempt to let-bind constant .nil.") + ;; 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 @@ -1202,7 +1265,7 @@ literals (Bug#20852)." (defun zot () (wrong-params 1 2 3))) '((callargs wrong-params)) - "Warning: wrong-params called with") + "Warning: .wrong-params. called with") (test-byte-comp-compile-and-load nil (defvar obsolete-variable nil) @@ -1243,25 +1306,25 @@ literals (Bug#20852)." (ert-deftest bytecomp-tests--not-writable-directory () "Test that byte compilation works if the output directory isn't writable (Bug#44631)." - (let ((directory (make-temp-file "bytecomp-tests-" :directory))) - (unwind-protect - (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)) - (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))))) - (with-demoted-errors "Error cleaning up directory: %s" - (set-file-modes directory #o700) - (delete-directory directory :recursive))))) + (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 @@ -1273,56 +1336,53 @@ mountpoint (Bug#44631)." (skip-unless (not (file-remote-p bwrap))) (skip-unless (file-executable-p emacs)) (skip-unless (not (file-remote-p emacs))) - (let ((directory (make-temp-file "bytecomp-tests-" :directory))) - (unwind-protect - (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) - (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))))) - (with-demoted-errors "Error cleaning up directory: %s" - (set-file-modes directory #o700) - (delete-directory directory :recursive)))))) + (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." - (let ((directory (make-temp-file "bytecomp-tests-" :directory))) - (unwind-protect - (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"))))) - (with-demoted-errors "Error cleaning up directory: %s" - (delete-directory directory :recursive))))) + (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)) @@ -1492,6 +1552,103 @@ 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 |