From 55f0576ebd4601fbf8e5e7ba9ab14e00fa2821b0 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 7 Apr 2021 13:11:43 +0200 Subject: Fix mistakes in bytecomp-tests * test/lisp/emacs-lisp/bytecomp-tests.el (byte-opt-testsuite-arith-data): Fix typos and avoid errors that made the tests less powerful than intended. --- test/lisp/emacs-lisp/bytecomp-tests.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'test/lisp/emacs-lisp/bytecomp-tests.el') diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 5147cd26883..0f7a0ccc851 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -364,17 +364,17 @@ '((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))) - (mapcar (lambda (x) (cond ((member '(a . b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1) + ((equal x '(c)) 2)))) '(((a . b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((memq '(a . b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1) + ((equal x '(c)) 2)))) '(((a . b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((member '(a b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1) + ((equal x '(c)) 2)))) '(((a b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((memq '(a b) x) 1) - ((equal x '(c)) 2))) + (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))) @@ -396,7 +396,7 @@ x) (let ((x 1) (bytecomp-test-var 2) (y 3)) - (list x bytecomp-test-var (bytecomp-get-test-var) y)) + (list x bytecomp-test-var (bytecomp-test-get-var) y)) (progn (defvar d) @@ -430,7 +430,7 @@ (list s x i)) (let ((x 2)) - (list (or (bytecomp-identity 'a) (setq x 3)) x))) + (list (or (bytecomp-test-identity 'a) (setq x 3)) x))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") -- cgit v1.2.3 From a2a7cfde29aa71f9ea503b8dc467d694f6e5b69f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 9 Apr 2021 18:42:12 +0200 Subject: Clean up bytecomp-tests.el Now all test cases are run with both lexical and dynamic binding where applicable, comparing interpreted against compiled results. Previously, almost all tests were only run with dynamic binding which was definitely not intended. * test/lisp/emacs-lisp/bytecomp-tests.el (byte-opt-testsuite-arith-data): Rename to bytecomp-tests--test-cases. (bytecomp-check-1, bytecomp-explain-1, bytecomp-tests) (bytecomp-lexbind-tests, bytecomp-lexbind-check-1) (bytecomp-lexbind-explain-1): Remove. (bytecomp-tests--eval-interpreted, bytecomp-tests--eval-compiled) (bytecomp-tests-lexbind, bytecomp-tests-dynbind) (bytecomp-tests--test-cases-lexbind-only): New. --- test/lisp/emacs-lisp/bytecomp-tests.el | 150 +++++++++++---------------------- 1 file changed, 47 insertions(+), 103 deletions(-) (limited to 'test/lisp/emacs-lisp/bytecomp-tests.el') diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 0f7a0ccc851..b1377e59f77 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -41,7 +41,7 @@ "Identity, but hidden from some optimisations." x) -(defconst byte-opt-testsuite-arith-data +(defconst bytecomp-tests--test-cases '( ;; some functional tests (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c)) @@ -430,69 +430,54 @@ (list s x i)) (let ((x 2)) - (list (or (bytecomp-test-identity 'a) (setq x 3)) x))) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") + (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) + ) + "List of expressions for cross-testing interpreted and compiled code.") -(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 err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) - -(defun bytecomp-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (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*")) +(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 err - (setq v0 (eval pat)) - (error (setq v0 (list 'bytecomp-check-error (car err))))) - (condition-case err - (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 (list 'bytecomp-check-error (car err))))) - (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) (declare (indent 1)) @@ -813,47 +798,6 @@ 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 err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile `(lambda nil ,pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) - -(defun bytecomp-lexbind-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile (list 'lambda nil pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (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) -- cgit v1.2.3 From b7a7e879d02570cbf74aa87686b6b0ed4e6b0c3b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 9 Apr 2021 18:49:16 +0200 Subject: Better compiler warning tests These changes allow all bytecomp-tests to be run interactively. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--with-warning-test) (bytecomp--define-warning-file-test): Interpret any space in the pattern as arbitrary whitespace to tolerate line breaks. Don't abuse the expected-failure mechanism when checking for the expected absense of a warning. (bytecomp/*.el): Rewrite patterns to work with line breaks in the middle. --- test/lisp/emacs-lisp/bytecomp-tests.el | 49 +++++++++++++++++----------------- 1 file changed, 25 insertions(+), 24 deletions(-) (limited to 'test/lisp/emacs-lisp/bytecomp-tests.el') diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index b1377e59f77..1953878d6f5 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -569,8 +569,8 @@ byte-compiled. Run with dynamic binding." `(with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) (byte-compile ,@form) - (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward ,re-warning))))) + (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" @@ -596,12 +596,13 @@ byte-compiled. Run with dynamic binding." (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () - :expected-result ,(if reverse :failed :passed) (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: ") - (should (re-search-forward ,re-warning)))))) + (,(if reverse 'should-not 'should) + (re-search-forward ,(string-replace " " "[ \n]+" re-warning) + nil t)))))) (bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el" "add-hook.*lexical var") @@ -643,10 +644,10 @@ byte-compiled. Run with dynamic binding." "free.*foo") (bytecomp--define-warning-file-test "warn-free-variable-reference.el" - "free.*bar") + "free variable .bar") (bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el" - "make-variable-buffer-local.*not called at toplevel") + "make-variable-buffer-local. not called at toplevel") (bytecomp--define-warning-file-test "warn-interactive-only.el" "next-line.*interactive use only.*forward-line") @@ -655,19 +656,19 @@ byte-compiled. Run with dynamic binding." "malformed interactive spec") (bytecomp--define-warning-file-test "warn-obsolete-defun.el" - "foo-obsolete.*obsolete function.*99.99") + "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-obs.*obsolete[^z-a]*99.99") + "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-obs.*obsolete[^z-a]*99.99") + "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) @@ -698,64 +699,64 @@ byte-compiled. Run with dynamic binding." (bytecomp--define-warning-file-test "warn-wide-docstring-autoload.el" - "autoload.*foox.*wider than.*characters") + "autoload .foox. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-custom-declare-variable.el" - "custom-declare-variable.*foo.*wider than.*characters") + "custom-declare-variable .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defalias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defconst.el" - "defconst.*foo.*wider than.*characters") + "defconst .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-abbrev-table.el" - "define-abbrev.*foo.*wider than.*characters") + "define-abbrev-table .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-function-alias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-variable-alias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo. docstring wider than .* characters") ;; TODO: We don't yet issue warnings for defuns. (bytecomp--define-warning-file-test "warn-wide-docstring-defun.el" - "wider than.*characters" 'reverse) + "wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-defvar.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defvaralias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-fill-column.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-override.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-multiline-first.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-multiline.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "nowarn-inline-after-defvar.el" -- cgit v1.2.3 From 59342f689eaa4839b0fc15351ae48b4f1074a6fc Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 9 Apr 2021 18:59:09 +0200 Subject: Fix condition-case optimiser bug * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't perform incorrect optimisations when a condition-case variable shadows another lexical variable. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): New test case. --- lisp/emacs-lisp/byte-opt.el | 10 ++++++++-- test/lisp/emacs-lisp/bytecomp-tests.el | 6 ++++++ 2 files changed, 14 insertions(+), 2 deletions(-) (limited to 'test/lisp/emacs-lisp/bytecomp-tests.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index db8d825cfec..e5265375314 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -528,8 +528,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") `(condition-case ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) + (let ((byte-optimize--lexvars + (and lexical-binding + (if var + (cons (list var t) + byte-optimize--lexvars) + byte-optimize--lexvars)))) + (cons (car clause) + (byte-optimize-body (cdr clause) for-effect)))) clauses)))) (`(unwind-protect ,exp . ,exps) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 1953878d6f5..94e33a7770e 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -431,6 +431,12 @@ (let ((x 2)) (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) + + (let* ((x 1) + (y (condition-case x + (/ 1 0) + (arith-error x)))) + (list x y)) ) "List of expressions for cross-testing interpreted and compiled code.") -- cgit v1.2.3 From 01a513bf0beb9478e2ef801ca28ebc992455fe3c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 11 Apr 2021 12:38:37 +0200 Subject: Fix typo in cconv * lisp/emacs-lisp/cconv.el (cconv-convert): Typo. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test case. --- lisp/emacs-lisp/cconv.el | 2 +- test/lisp/emacs-lisp/bytecomp-tests.el | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) (limited to 'test/lisp/emacs-lisp/bytecomp-tests.el') diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index afaa13a8695..b37cfebab31 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -498,7 +498,7 @@ places where they originally did not directly appear." (let* ((class (and var (cconv--var-classification (list var) form))) (newenv (cond ((eq class :captured+mutated) - (cons `(,var . (car-save ,var)) env)) + (cons `(,var . (car-safe ,var)) env)) ((assq var env) (cons `(,var) env)) (t env))) (msg (when (eq class :unused) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 94e33a7770e..a11832d805e 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -437,6 +437,13 @@ (/ 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) ) "List of expressions for cross-testing interpreted and compiled code.") -- cgit v1.2.3