diff options
Diffstat (limited to 'test/lisp/emacs-lisp')
53 files changed, 701 insertions, 155 deletions
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index 14f95a8bf80..842ef10bc57 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -1,4 +1,4 @@ -;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; -*- +;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*- ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. @@ -94,7 +94,13 @@ (src-ip . [192 168 1 101]) (dest-ip . - [192 168 1 100])))))) + [192 168 1 100])))))) + +(ert-deftest bindat-test-pack/multibyte-string-fails () + (should-error (bindat-pack nil nil "ö"))) + +(ert-deftest bindat-test-unpack/multibyte-string-fails () + (should-error (bindat-unpack nil "ö"))) (ert-deftest bindat-test-format-vector () (should (equal (bindat-format-vector [1 2 3] "%d" "x" 2) "1x2")) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el new file mode 100644 index 00000000000..5f390898e6a --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t; -*- +(let ((foo nil)) + (add-hook 'foo #'next-line) + foo) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el new file mode 100644 index 00000000000..eaa625eba1c --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t; -*- +(let ((foo nil)) + (remove-hook 'foo #'next-line) + foo) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el new file mode 100644 index 00000000000..7a116ad464b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t; -*- +(let ((foo nil)) + (run-hook-with-args-until-failure 'foo)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el new file mode 100644 index 00000000000..96d10a343df --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t; -*- +(let ((foo nil)) + (run-hook-with-args-until-success 'foo #'next-line)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el new file mode 100644 index 00000000000..bb9101bd070 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t; -*- +(let ((foo nil)) + (run-hook-with-args 'foo)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el new file mode 100644 index 00000000000..5f390898e6a --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t; -*- +(let ((foo nil)) + (add-hook 'foo #'next-line) + foo) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el new file mode 100644 index 00000000000..f193130c6ca --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (autoload 'bar "baz" nil nil 'macro)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el new file mode 100644 index 00000000000..687add380b9 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el @@ -0,0 +1,5 @@ +;;; -*- lexical-binding: t -*- +(defun foo (_x) + nil) +(defun bar () + (foo 1 2)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el new file mode 100644 index 00000000000..a67d4f041f3 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defcustom foo nil + :type 'boolean) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el new file mode 100644 index 00000000000..c15ab9b192a --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defcustom foo nil + :group 'emacs) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el new file mode 100644 index 00000000000..9f3cbb98900 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el @@ -0,0 +1,2 @@ +;;; -*- lexical-binding: t -*- +(defvar foo nil) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-format.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-format.el new file mode 100644 index 00000000000..a1902bc03b0 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-format.el @@ -0,0 +1,2 @@ +;;; -*- lexical-binding: t -*- +(message "%s" 1 2) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el new file mode 100644 index 00000000000..6e187129c9b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el @@ -0,0 +1,2 @@ +;;; -*- lexical-binding: t -*- +(setq foo 'bar) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el new file mode 100644 index 00000000000..50a95272874 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t -*- +(defvar xxx-test) +(defun foo () + (setq xxx-test bar)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el new file mode 100644 index 00000000000..9e0c99bd30b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (next-line)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el new file mode 100644 index 00000000000..6bd902705ed --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (interactive "foo" "bar") + nil) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el new file mode 100644 index 00000000000..aa1e6c0463b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t -*- +(defvar foobar) +(defun foo () + (make-variable-buffer-local 'foobar)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el new file mode 100644 index 00000000000..2a7af617ac9 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el @@ -0,0 +1,8 @@ +;;; -*- lexical-binding: t -*- + +(defun foo-obsolete () + (declare (obsolete nil "99.99")) + nil) + +(defun foo () + (foo-obsolete)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el new file mode 100644 index 00000000000..078e6e4a3a9 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (add-hook 'bytecomp--tests-obsolete-var #'next-line)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el new file mode 100644 index 00000000000..31deb6155ba --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el @@ -0,0 +1,13 @@ +;;; -*- lexical-binding: t -*- + +(defvar foo-obsolete nil) +(make-obsolete-variable 'foo-obsolete nil "99.99") + +;; From bytecomp.el: +;; If foo.el declares `toto' as obsolete, it is likely that foo.el will +;; actually use `toto' in order for this obsolete variable to still work +;; correctly, so paradoxically, while byte-compiling foo.el, the presence +;; of a make-obsolete-variable call for `toto' is an indication that `toto' +;; should not trigger obsolete-warnings in foo.el. +(defun foo () + foo-obsolete) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el new file mode 100644 index 00000000000..9a517cc6767 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t -*- + +(defun foo () + bytecomp--tests-obsolete-var) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el new file mode 100644 index 00000000000..6bd239b6598 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () nil) +(defmacro foo () t) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el new file mode 100644 index 00000000000..53e4c0ac8de --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () nil) +(defun foo () t) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el new file mode 100644 index 00000000000..f71ae445615 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defmacro foo () t) +(defun foo () nil) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el new file mode 100644 index 00000000000..38185457192 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el @@ -0,0 +1,5 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (save-excursion + (set-buffer (current-buffer)) + nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el new file mode 100644 index 00000000000..cc1fb572577 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (let ((t 1)) t)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el new file mode 100644 index 00000000000..dde2dcee6e7 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (let (('t 1)) t)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el new file mode 100644 index 00000000000..2fc0680cfab --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (setq t nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el new file mode 100644 index 00000000000..0c76c4d388b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + (set '(a) nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a9dcf152617..c2a3e3ba117 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -26,6 +26,7 @@ ;;; Commentary: (require 'ert) +(require 'ert-x) (require 'cl-lib) (require 'subr-x) (require 'bytecomp) @@ -365,7 +366,12 @@ '(((a b)) a b (c) (d))) (mapcar (lambda (x) (cond ((memq '(a b) x) 1) ((equal x '(c)) 2))) - '(((a b)) a b (c) (d)))) + '(((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))))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") @@ -444,8 +450,8 @@ Subtests signal errors if something goes wrong." (if compile (let ((byte-compile-dest-file-function (lambda (e) elcfile))) - (byte-compile-file elfile t)) - (load elfile nil 'nomessage))) + (byte-compile-file elfile))) + (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) @@ -484,6 +490,9 @@ 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))) @@ -511,19 +520,127 @@ 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 ((buffer-string) :prefix "buffer: ") + (should (re-search-forward ,re-warning))))) + (ert-deftest bytecomp-warn-wrong-args () - (with-current-buffer (get-buffer-create "*Compile-Log*") - (let ((inhibit-read-only t)) (erase-buffer)) - (byte-compile '(remq 1 2 3)) - (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward "remq.*3.*2"))))) + (bytecomp--with-warning-test "remq.*3.*2" + '(remq 1 2 3))) (ert-deftest bytecomp-warn-wrong-args-subr () - (with-current-buffer (get-buffer-create "*Compile-Log*") - (let ((inhibit-read-only t)) (erase-buffer)) - (byte-compile '(safe-length 1 2 3)) - (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward "safe-length.*3.*1"))))) + (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))) + +(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)))))) + +(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-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.*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 spec") + +(bytecomp--define-warning-file-test "warn-obsolete-defun.el" + "foo-obsolete.*obsolete function.*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.*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.*99.99") + +(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" + "variable reference to constant") + +(bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el" + "variable reference to nonvariable") + + +;;;; Macro expansion. (ert-deftest test-eager-load-macro-expansion () (test-byte-comp-compile-and-load nil @@ -646,7 +763,8 @@ literals (Bug#20852)." (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 () @@ -804,6 +922,12 @@ literals (Bug#20852)." (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)) @@ -823,6 +947,75 @@ literals (Bug#20852)." '((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)." + (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-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))) + (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)))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 5aa58782f36..9582907e511 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -240,7 +240,7 @@ (let ((retval (cl--generic-method-files 'cl-generic-tests--generic))) (should (equal (length retval) 2)) (mapc (lambda (x) - (should (equal (car x) cl-generic-tests--this-file)) + (should (equal (file-truename (car x)) cl-generic-tests--this-file)) (should (equal (cadr x) 'cl-generic-tests--generic))) retval) (should-not (equal (nth 0 retval) (nth 1 retval))))) diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el new file mode 100644 index 00000000000..77b9e05da67 --- /dev/null +++ b/test/lisp/emacs-lisp/copyright-tests.el @@ -0,0 +1,50 @@ +;;; copyright-tests.el --- tests for copyright.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'copyright) + +(defmacro with-copyright-test (orig result) + `(cl-letf (((symbol-function 'format-time-string) (lambda (&rest _) "2019"))) + (let ((copyright-query nil) + (copyright-current-year 2019)) + (with-temp-buffer + (insert ,orig) + (copyright-update) + (should (equal (buffer-string) ,result)))))) + +(defvar copyright-tests--data + '((";; Copyright (C) 2017 Free Software Foundation, Inc." + . ";; Copyright (C) 2017, 2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2017-2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2005-2006, 2015, 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2005-2006, 2015, 2017-2019 Free Software Foundation, Inc.") + (";; copyright '18 FSF" + . ";; copyright '18, '19 FSF"))) + +(ert-deftest test-copyright-update () + (dolist (test copyright-tests--data) + (with-copyright-test (car test) (cdr test)))) + +(provide 'copyright-tests) +;;; copyright-tests.el ends here diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el new file mode 100644 index 00000000000..bbd01970b5b --- /dev/null +++ b/test/lisp/emacs-lisp/easy-mmode-tests.el @@ -0,0 +1,65 @@ +;;; easy-mmode-tests.el --- tests for easy-mmode.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'easy-mmode) +(require 'message) + +(ert-deftest easy-mmode--globalized-predicate () + (with-temp-buffer + (emacs-lisp-mode) + (should (eq (easy-mmode--globalized-predicate-p nil) nil)) + (should (eq (easy-mmode--globalized-predicate-p t) t)) + (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t)) + (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t)) + (should (eq (easy-mmode--globalized-predicate-p '((not text-mode))) nil)) + (should (eq (easy-mmode--globalized-predicate-p '((not text-mode) t)) t)) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode emacs-lisp-mode)) + t)) + (mail-mode) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode (not message-mode mail-mode) text-mode)) + nil)) + (text-mode) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode (not message-mode mail-mode) text-mode)) + t)))) + +(define-minor-mode easy-mmode-test-mode "A test.") + +(ert-deftest easy-mmode--minor-mode () + (with-temp-buffer + (should (eq easy-mmode-test-mode nil)) + (easy-mmode-test-mode nil) + (should (eq easy-mmode-test-mode t)) + (easy-mmode-test-mode -33) + (should (eq easy-mmode-test-mode nil)) + (easy-mmode-test-mode 33) + (should (eq easy-mmode-test-mode t)) + (easy-mmode-test-mode 'toggle) + (should (eq easy-mmode-test-mode nil)) + (easy-mmode-test-mode 'toggle) + (should (eq easy-mmode-test-mode t)))) + +(provide 'easy-mmode-tests) + +;;; easy-mmode-tests.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 6db07b1b707..2c340c44408 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -36,17 +36,6 @@ (require 'edebug) (require 'kmacro) -;; Use `eval-and-compile' because this is used by the macro -;; `edebug-tests-deftest'. -(eval-and-compile - (defvar edebug-tests-sample-code-file - (expand-file-name - "edebug-resources/edebug-test-code.el" - (file-name-directory (or (bound-and-true-p byte-compile-current-file) - load-file-name - buffer-file-name))) - "Name of file containing code samples for Edebug tests.")) - (defvar edebug-tests-temp-file nil "Name of temp file containing sample code stripped of stop point symbols.") (defvar edebug-tests-stop-points nil @@ -108,7 +97,10 @@ back to the top level.") ;; sit-on interferes with keyboard macros. (edebug-sit-on-break nil) - (edebug-continue-kbd-macro t)) + (edebug-continue-kbd-macro t) + + ;; don't print backtraces, otherwise error messages don't match + (backtrace-on-error-noninteractive nil)) ,@body)) (defmacro edebug-tests-with-normal-env (&rest body) @@ -116,7 +108,8 @@ back to the top level.") (declare (debug (body))) `(edebug-tests-with-default-config (let ((edebug-tests-failure-in-post-command nil) - (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el"))) + (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el")) + (find-file-suppress-same-file-warnings t)) (edebug-tests-setup-code-file edebug-tests-temp-file) (ert-with-message-capture edebug-tests-messages @@ -221,6 +214,7 @@ be the same as every keystroke) execute the thunk at the same index." (let* ((edebug-tests-thunks thunks) (edebug-tests-kbd-macro-index 0) + (find-file-suppress-same-file-warnings t) saved-local-map) (with-current-buffer (find-file-noselect edebug-tests-temp-file) (setq saved-local-map overriding-local-map) @@ -344,7 +338,7 @@ evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc." Write the loadable code to a buffer for TMPFILE, and set `edebug-tests-stop-points' to a map from defined symbols to stop point names to positions in the file." - (with-current-buffer (find-file-noselect edebug-tests-sample-code-file) + (with-current-buffer (find-file-noselect (ert-resource-file "edebug-test-code.el")) (let ((marked-up-code (buffer-string))) (with-temp-file tmpfile (insert marked-up-code)))) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 96189356c02..a0c56be0cb0 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -801,6 +801,21 @@ This macro is used to test if macroexpansion in `should' works." (should (eql 0 (ert-stats-completed-unexpected stats))) (should (eql 1 (ert-stats-skipped stats))))) +(ert-deftest ert-test-with-demoted-errors () + "Check that ERT correctly handles `with-demoted-errors'." + :expected-result :failed ;; FIXME! Bug#11218 + (should-not (with-demoted-errors (error "Foo")))) + +(ert-deftest ert-test-fail-inside-should () + "Check that `ert-fail' inside `should' works correctly." + (let ((result (ert-run-test + (make-ert-test + :name 'test-1 + :body (lambda () (should (integerp (ert-fail "Boo")))))))) + (should (ert-test-failed-p result)) + (should (equal (ert-test-failed-condition result) + '(ert-test-failed ("Boo")))))) + (provide 'ert-tests) diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el index c77f2dc4990..6e9d50fc38f 100644 --- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el +++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el @@ -67,8 +67,8 @@ If `prog-mode' is defined, inherit from it." (faceup-test-define-prog-mode faceup-test-mode "faceup-test" "Dummy major mode for testing `faceup', a test system for font-lock." - (set (make-local-variable 'syntax-propertize-function) - #'faceup-test-syntax-propertize) + (setq-local syntax-propertize-function + #'faceup-test-syntax-propertize) (setq font-lock-defaults '(faceup-test-font-lock-keywords nil))) (provide 'faceup-test-mode) diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el index f505e78566e..d77eb6757ff 100644 --- a/test/lisp/emacs-lisp/find-func-tests.el +++ b/test/lisp/emacs-lisp/find-func-tests.el @@ -5,18 +5,20 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el index 29e4273b478..8fc6b514692 100644 --- a/test/lisp/emacs-lisp/gv-tests.el +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -83,7 +83,10 @@ (with-temp-buffer (call-process (concat invocation-directory invocation-name) nil '(t t) nil - "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-Q" "-batch" + "--eval" (prin1-to-string + `(let ((backtrace-on-error-noninteractive nil)) + (byte-compile-file ,el))) "-l" elc) (should (equal (buffer-string) "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) @@ -133,8 +136,10 @@ "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) "-l" elc "--eval" - (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) - (message "%d" (car gv-test-pair))))) + (prin1-to-string + '(let ((backtrace-on-error-noninteractive nil)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) (should (string-match "\\`Symbol.s function definition is void: \\\\(setf\\\\ gv-test-foo\\\\)\n\\'" (buffer-string)))))) diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el new file mode 100644 index 00000000000..b67ec6c0103 --- /dev/null +++ b/test/lisp/emacs-lisp/memory-report-tests.el @@ -0,0 +1,57 @@ +;;; memory-report-tests.el --- tests for memory-report.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +(require 'ert) +(require 'memory-report) + +(defun setup-memory-report-tests () + ;; Set the sizes on things based on a 64-bit architecture. (We're + ;; hard-coding this to be able to write simple tests that'll work on + ;; all architectures.) + (memory-report--set-size + '((conses 16 499173 99889) + (symbols 48 22244 3) + (strings 32 92719 4559) + (string-bytes 1 40402011) + (vectors 16 31919) + (vector-slots 8 385148 149240) + (floats 8 434 4519) + (intervals 56 24499 997) + (buffers 984 33)))) + +(ert-deftest memory-report-sizes () + (setup-memory-report-tests) + (should (equal (memory-report-object-size (cons nil nil)) 16)) + (should (equal (memory-report-object-size (cons 1 2)) 16)) + + (should (equal (memory-report-object-size (list 1 2)) 32)) + (should (equal (memory-report-object-size (list 1)) 16)) + + (should (equal (memory-report-object-size (list 'foo)) 16)) + + (should (equal (memory-report-object-size (vector 1 2 3 4)) 80)) + + (should (equal (memory-report-object-size "") 32)) + (should (equal (memory-report-object-size "a") 33)) + (should (equal (memory-report-object-size (propertize "a" 'face 'foo)) + 81))) + +(provide 'memory-report-tests) + +;;; memory-report-tests.el ends here diff --git a/test/lisp/emacs-lisp/package-resources/key.pub b/test/lisp/emacs-lisp/package-resources/key.pub index a326d34e54f..5e2ebc55d35 100644 --- a/test/lisp/emacs-lisp/package-resources/key.pub +++ b/test/lisp/emacs-lisp/package-resources/key.pub @@ -1,18 +1,20 @@ -----BEGIN PGP PUBLIC KEY BLOCK----- -Version: GnuPG v1.4.14 (GNU/Linux) -mQENBFJNB8gBCACfbtpvYrM8V1HM0KFlIwatcEJugHqwOHpr/Z9mrCW0fxyQAW/d -2L+3QVNsN9Tz/K9lLcBUgeR7rhVEzHNqhmhNj/HnikwGqXbIofhp+QbZmBKnAlCz -d77kg8K9lozHtfTkm1gX/7DdPzQKmgi7WOzzi2395wGubeqJLvYaEcqVbI0Eob+E -3CzRjNy/e/Tf3TJRW5etTcdZN6LVuIY7tNCHqlQZTwyycON/hfLTX6cLCnzDsqm/ -NxCuwn9aqP9aGRGfIu7Y+If3zTymvrXEPUN98OEID814bOKdx0uVTZRiSMbvuTGI -8uMa/kpGX/78rqI61gbZV51RFoU7pT2tzwY/ABEBAAG0HkouIFIuIEhhY2tlciA8 -anJoQGV4YW1wbGUuY29tPokBOAQTAQIAIgUCUk0HyAIbAwYLCQgHAwIGFQgCCQoL -BBYCAwECHgECF4AACgkQtpVAhgkYletuhQf+JAyHYhTZNxjq0UYlikuLX8EtYbXX -PB+03J0B73SMzEai5XsiTU2ADxqxwr7pveVK1INf+IGLiiXBlQq+4DSOvQY4xLfp -58jTOYRV1ECvlXK/JtvVOwufXREADaydf9l/MUxA5G2PPBWIuQknh3ysPSsx68OJ -SzNHFwklLn0DKc4WloE/GLDpTzimnCg7QGzuUo3Iilpjdy8EvTdI5d3jx/mGJIwI -goB+YZgyxSPM+GjDwh5DEwD7OexNqqa7RynnmU0epmlYyi9UufCHLwgiiEIzjpWi -6+iF+CQ45ZAKncovByenIUv73J3ImOudrsskeAHBmahljv1he6uV9Egj2Q== -=b5Kg +mI0EX48EbAEEANrsWXyZ4MRZRjVbLAh5jX/+1+31oB/aJ/q/5DkH1qUHJf0La9LC +sykUSM3H2u5VWLytX/ozrxIRYX13GR2xBxyJlUkDWB209AAVLFrjSp1yUX/Sb5SU +Kb7p421ZAeHiOxfnLRuErFZkTfzY19mUCyw4cdamw430V3mUC9uns/d9ABEBAAG0 +LUouIFJhbmRvbSBIYWNrZXIgKFRFU1QgS0VZKSA8anJoQGV4YW1wbGUub3JnPojO +BBMBCgA4FiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+PBGwCGwMFCwkIBwIGFQoJ +CAsCBBYCAwECHgECF4AACgkQMKdkJgeTYhq9MQP7BYkCk8r5G777Ilp8kWjsEIo3 +aDX9jORiNfMAGys/aLjjEajHFAlTQKfSLm/VXLDYtK28c8ACjThQagaDF46MRWqQ +rFFiH4IAZRgj2ELj+/j1ljQZjGjKR2Yx4BCDhbumz8zeMSPL6yFT5+8LOMUAtdv4 +lEPWXW0AycylbdbE7024jQRfjwRsAQQApjTw9kONmSVouCi8ZIQwwYiA9tLzbSZv +CYxbJ6KH0icRhBLfdb1hL/Kn8x3k+xll9A0c/ABVkMxRcbQkY98xsFck7E2GcvnC +sY+w/NdcUUZJYMB3l2MH5ojCbOk5jSAZzxzeFcJhNAhmLqomMHg2LI6KDVey6iYU +FxyIpIQ3SlkAEQEAAYi2BBgBCgAgFiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+P +BGwCGwwACgkQMKdkJgeTYhrtywQAhoCR/skBSQWWBI10N0qhtdlNxbpvK8ErSPKw +wS74Pq407Zv0VD9ual/HC3Uet2z8LeG9ZwU4Jd23g96fmJt7AM9CQWrOhC242JYr +YSqWxANyek8otsvppJNHtt2Stmknv7XbJFFB1JDC8WKo8lVo9/MkmzROxuEFEvOU +Yn923VI= +=NRtx -----END PGP PUBLIC KEY BLOCK----- diff --git a/test/lisp/emacs-lisp/package-resources/key.sec b/test/lisp/emacs-lisp/package-resources/key.sec index d21e6ae9a45..dbc80f43cb7 100644 --- a/test/lisp/emacs-lisp/package-resources/key.sec +++ b/test/lisp/emacs-lisp/package-resources/key.sec @@ -1,33 +1,35 @@ -----BEGIN PGP PRIVATE KEY BLOCK----- -Version: GnuPG v1.4.14 (GNU/Linux) -lQO+BFJNB8gBCACfbtpvYrM8V1HM0KFlIwatcEJugHqwOHpr/Z9mrCW0fxyQAW/d -2L+3QVNsN9Tz/K9lLcBUgeR7rhVEzHNqhmhNj/HnikwGqXbIofhp+QbZmBKnAlCz -d77kg8K9lozHtfTkm1gX/7DdPzQKmgi7WOzzi2395wGubeqJLvYaEcqVbI0Eob+E -3CzRjNy/e/Tf3TJRW5etTcdZN6LVuIY7tNCHqlQZTwyycON/hfLTX6cLCnzDsqm/ -NxCuwn9aqP9aGRGfIu7Y+If3zTymvrXEPUN98OEID814bOKdx0uVTZRiSMbvuTGI -8uMa/kpGX/78rqI61gbZV51RFoU7pT2tzwY/ABEBAAH+AwMCKCCpPNXkXuVgF7cz -eByuvgIO7wImDYGOdJqsASSzV4q0u1acnGtlxg7WphKDF9RnC5+1ZZ1ZcrBcv2uJ -xZm2jHdjqM3FmgQTN70GVzO1nKEur2wxlKotG4Q+8BtaRDwHdKpQFk+QW9aInH3C -BkNWTK97iFwZaoUGxKuRJb35qjMe3SsDE7kdbtOqO+tOeppRVeOOZCn7F33ir/6i -j2gmIME6LFDzvBi6YAyMBSh90Ak70HJINt0QfXlZf5MtX1NaxaEcnsRmwwcNqxh9 -JvcC9q4WrR92NhHCHI+lOsAe7hbwo/VkwRjSSx0HdKkx6kvdcNj/9LeX/jykzLvg -kEqvAqT4Jmk57W2seqvpNcAO+eUVrJ5D1OR6khsUtikPp2pQH5MDXJDGcie+ZAFb -w6BwoWBDBjooKtfuP0LKqrdtJG2JLe6yhBhWvfqHPBlUU1SsA7a5aTCLo8FiqgEI -Kyy60zMx/2Mi48oN1a/mAoV1MTWLhOVUWJlIHM7nVLj1OaX0316LcLX/uTLTq40p -apHKwERanzY7f8ROiv/Fa/J+9cCsfOLKfjFAjpBVUVoOb39HsyS/vvkGMY4kgaD6 -K6r9JPdsaoYvsLkxk5HyHF7Mk2uS1z1EIArD2/3lRiX6ag+IU1Nl3XDkgfZj06K3 -juS84dGF8CmN49uOEjzAJAQZH9jTs5OKzUuZhGJF+gt0L78vLOoKRr8bu1N1GPqU -wnS908HWruXzjJl1CAhnuCa8FnDaU+tmEKjYpWuelx85kolpMW7LT5gOFZr84MIj -Kq3Rt2hU6qQ7Cdy1ep531YKkmyh9Y4l/Tgir1OtnQQqtNuwHI497l7qAUnKZBBHZ -guApjS9BoHsRXkw2mgDssZ+khOwj/xJm876nFSiQeCD0aIbU/4zJ9e2HUOJAZI1r -d7QeSi4gUi4gSGFja2VyIDxqcmhAZXhhbXBsZS5jb20+iQE4BBMBAgAiBQJSTQfI -AhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRC2lUCGCRiV626FB/4kDIdi -FNk3GOrRRiWKS4tfwS1htdc8H7TcnQHvdIzMRqLleyJNTYAPGrHCvum95UrUg1/4 -gYuKJcGVCr7gNI69BjjEt+nnyNM5hFXUQK+Vcr8m29U7C59dEQANrJ1/2X8xTEDk -bY88FYi5CSeHfKw9KzHrw4lLM0cXCSUufQMpzhaWgT8YsOlPOKacKDtAbO5SjciK -WmN3LwS9N0jl3ePH+YYkjAiCgH5hmDLFI8z4aMPCHkMTAPs57E2qprtHKeeZTR6m -aVjKL1S58IcvCCKIQjOOlaLr6IX4JDjlkAqdyi8HJ6chS/vcnciY652uyyR4AcGZ -qGWO/WF7q5X0SCPZ -=5FZK +lQIGBF+PBGwBBADa7Fl8meDEWUY1WywIeY1//tft9aAf2if6v+Q5B9alByX9C2vS +wrMpFEjNx9ruVVi8rV/6M68SEWF9dxkdsQcciZVJA1gdtPQAFSxa40qdclF/0m+U +lCm+6eNtWQHh4jsX5y0bhKxWZE382NfZlAssOHHWpsON9Fd5lAvbp7P3fQARAQAB +/gcDAngNw4ppSPBe/w734cz++xNEv0TDgwxGBWp2wGSwWao04Nl1U4LkjiIy+dkc +uUPwEZMvxXwMcq10PPH26ifP8Xfi/zANXUoLJ0DsG6rtE3BcSC9MPFe3EJENtcIP +a0jFLsbi72aBzolNEDCZCv93znXFPekaXw/RAeeFLJz8GR2Sx6bHbTJKklXgWPHw +C5Dw6xr/kEZktgjlhjkx280STpLGaFO4jiiGZ4Obp5ePp7kyOzDUzaimdZgJwClT +VbZDNQMTzgQrBOP8doXlo9euW4Wo1IYBIOwgeYieM3ZA9YjJAmp4lFnk/KFYt0Ak +0H9IWzDU8VERcU4B04PSXahzvB1Ii7C7bbHxPyuu6sAfMK8DRkrGjwgAlrhuWNLX +M07acT/E9Pm+mBlDcdkyKB2LfwgaVb9F3C25sfcFSvc5p+sqgZp1Zx7Qg9pOhQjw +U7Ln+96c0bUl+iQKdm3TGjOXAFUHYXbRkx2cJ4gxnMVNj0D68xBtBSm0LUouIFJh +bmRvbSBIYWNrZXIgKFRFU1QgS0VZKSA8anJoQGV4YW1wbGUub3JnPojOBBMBCgA4 +FiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+PBGwCGwMFCwkIBwIGFQoJCAsCBBYC +AwECHgECF4AACgkQMKdkJgeTYhq9MQP7BYkCk8r5G777Ilp8kWjsEIo3aDX9jORi +NfMAGys/aLjjEajHFAlTQKfSLm/VXLDYtK28c8ACjThQagaDF46MRWqQrFFiH4IA +ZRgj2ELj+/j1ljQZjGjKR2Yx4BCDhbumz8zeMSPL6yFT5+8LOMUAtdv4lEPWXW0A +ycylbdbE702dAgYEX48EbAEEAKY08PZDjZklaLgovGSEMMGIgPbS820mbwmMWyei +h9InEYQS33W9YS/yp/Md5PsZZfQNHPwAVZDMUXG0JGPfMbBXJOxNhnL5wrGPsPzX +XFFGSWDAd5djB+aIwmzpOY0gGc8c3hXCYTQIZi6qJjB4NiyOig1XsuomFBcciKSE +N0pZABEBAAH+BwMCXeUOBwcOsxb/AY6rnHmgACNTGwIa5vgelw0qfET0ms/YzVrN +ufikyV9dEWVxJyuTKav978wanPu7VcCh0pTjL2nTm2nZWyRJN4gb3UIC0MA1xfB2 +yPLTCmsGeJhVOqi4Af/r06mk+NOQ96ivOA2CJuw1LSpcUtuYxB5t/grGyEojYjRP +s0Htvf2bfN9KbFJ26DGsfYzC8bCxm9szPFHBQjw4NboCigUSAHmkoTW01aWZU9Vq +brY4cWhdmCqHgfmsQgzP3LfaAQ6kJ/bkuKef7z57lz5XmlyjMQGWcZWp5xf2n81p +BV6unaIPyavzkKVAXizVfNiHNJgK9PoVoEOJkPLjRfMxVmFSGN/oF7lVTRWfOIwo +68rtNPhr6UzE4ArGHYv/pK3kijUp5daWmfrySWPcwoVAaR3mIIVs/1rhd9aZrwn6 +Q07Yo5u11rH9b8anZQF3BdTcrnU9pUzLYlFPnfhtyGqhikQILtPTf0iwr8hpG9b2 +Zoi2BBgBCgAgFiEEHP310DrP36xrZ1kSMKdkJgeTYhoFAl+PBGwCGwwACgkQMKdk +JgeTYhrtywQAhoCR/skBSQWWBI10N0qhtdlNxbpvK8ErSPKwwS74Pq407Zv0VD9u +al/HC3Uet2z8LeG9ZwU4Jd23g96fmJt7AM9CQWrOhC242JYrYSqWxANyek8otsvp +pJNHtt2Stmknv7XbJFFB1JDC8WKo8lVo9/MkmzROxuEFEvOUYn923VI= +=2DW8 -----END PGP PRIVATE KEY BLOCK----- diff --git a/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig Binary files differindex 658edd3f60e..dac168b0e4c 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig diff --git a/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el index 3734823876e..ff070c6526f 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el @@ -1,4 +1,4 @@ -;;; signed-bad.el --- A single-file package with bad signature +;;; signed-bad.el --- A single-file package with bad signature -*- lexical-binding: t -*- ;; Author: J. R. Hacker <jrh@example.com> ;; Version: 1.0 diff --git a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el index 22718df2763..60b1b8663d9 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el @@ -1,4 +1,4 @@ -;;; signed-good.el --- A single-file package with good signature +;;; signed-good.el --- A single-file package with good signature -*- lexical-binding: t -*- ;; Author: J. R. Hacker <jrh@example.com> ;; Version: 1.0 diff --git a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig Binary files differindex 747918794ca..5b1c721e32a 100644 --- a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig diff --git a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh new file mode 100755 index 00000000000..a48c9bb1aa2 --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh @@ -0,0 +1,32 @@ +#! /bin/sh + +# Generate a new key and update the signatures for tests. + +# Copyright (C) 2020 Free Software Foundation, Inc. + +# This file is part of GNU Emacs. + +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +export GPG_AGENT="" +KEYRING="./key.ring" +TRUSTDB="./trust.db" +GPG="gpg --no-default-keyring --trustdb-name $TRUSTDB --keyring $KEYRING --yes" + +rm $KEYRING +$GPG --full-generate-key +$GPG --export --armor > "../key.pub" +$GPG --export-secret-keys -armor > "../key.sec" +$GPG --detach-sign --sign "./archive-contents" +$GPG --detach-sign --sign "./signed-good-1.0.el" diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index cbb2410f953..23267545f83 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -39,6 +39,7 @@ (require 'package) (require 'ert) +(require 'ert-x) (require 'cl-lib) (setq package-menu-async nil) @@ -102,13 +103,9 @@ (multi-file (0 1)))) "`package-desc' used for testing dependencies.") -(defvar package-test-data-dir (expand-file-name "package-resources" package-test-file-dir) +(defvar package-test-data-dir (ert-resource-directory) "Base directory of package test files.") -(defvar package-test-fake-contents-file - (expand-file-name "archive-contents" package-test-data-dir) - "Path to a static copy of \"archive-contents\".") - (cl-defmacro with-package-test ((&optional &key file basedir install @@ -154,6 +151,15 @@ `(insert-file-contents ,file)) ,@body))) + (when ,upload-base + (dolist (f '("archive-contents" + "simple-single-1.3.el" + "simple-single-1.4.el" + "simple-single-readme.txt")) + (ignore-errors + (delete-file + (expand-file-name f package-test-archive-upload-base)))) + (delete-directory package-test-archive-upload-base)) (when (file-directory-p package-test-user-dir) (delete-directory package-test-user-dir t)) @@ -215,20 +221,20 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-desc-from-buffer () "Parse an elisp buffer to get a `package-desc' object." - (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el") + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el") (should (package-test--compatible-p (package-buffer-info) simple-single-desc 'kind))) - (with-package-test (:basedir "package-resources" :file "simple-depend-1.0.el") + (with-package-test (:basedir (ert-resource-directory) :file "simple-depend-1.0.el") (should (package-test--compatible-p (package-buffer-info) simple-depend-desc 'kind))) - (with-package-test (:basedir "package-resources" + (with-package-test (:basedir (ert-resource-directory) :file "multi-file-0.2.3.tar") (tar-mode) (should (equal (package-tar-file-info) multi-file-desc)))) (ert-deftest package-test-install-single () "Install a single file without using an archive." - (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el") + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el") (should (package-install-from-buffer)) (package-initialize) (should (package-installed-p 'simple-single)) @@ -271,7 +277,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-macro-compilation () "Install a package which includes a dependency." - (with-package-test (:basedir "package-resources") + (with-package-test (:basedir (ert-resource-directory)) (package-install-file (expand-file-name "macro-problem-package-1.0/")) (require 'macro-problem) ;; `macro-problem-func' uses a macro from `macro-aux'. @@ -310,8 +316,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-install-prioritized () "Install a lower version from a higher-prioritized archive." (with-package-test () - (let* ((newer-version (expand-file-name "package-resources/newer-versions" - package-test-file-dir)) + (let* ((newer-version (ert-resource-file "newer-versions")) (package-archives `(("older" . ,package-test-data-dir) ("newer" . ,newer-version))) (package-archive-priorities '(("older" . 100)))) @@ -326,7 +331,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-install-multifile () "Check properties of the installed multi-file package." - (with-package-test (:basedir "package-resources" :install '(multi-file)) + (with-package-test (:basedir (ert-resource-directory) :install '(multi-file)) (let ((autoload-file (expand-file-name "multi-file-autoloads.el" (expand-file-name @@ -472,8 +477,7 @@ Must called from within a `tar-mode' buffer." (package-menu-mark-install) (package-menu-execute) (should (package-installed-p 'simple-single)) - (let ((package-test-data-dir - (expand-file-name "package-resources/newer-versions" package-test-file-dir))) + (let ((package-test-data-dir (ert-resource-file "newer-versions"))) (setq package-archives `(("gnu" . ,package-test-data-dir))) (revert-buffer) @@ -512,7 +516,7 @@ Must called from within a `tar-mode' buffer." (when (re-search-forward "Server started, \\(.*\\)\n" nil t) (setq addr (match-string 1)))) addr))) - (with-package-test (:basedir package-test-data-dir :location addr) + (with-package-test (:basedir (ert-resource-directory) :location addr) (list-packages) (should package--downloads-in-progress) (should mode-line-process) @@ -532,8 +536,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-update-archives/ignore-nil-entry () "Ignore any packages that are nil. Test for Bug#28502." (with-package-test () - (let* ((with-nil-entry (expand-file-name "package-resources/with-nil-entry" - package-test-file-dir)) + (let* ((with-nil-entry (ert-resource-file "with-nil-entry")) (package-archives `(("with-nil-entry" . ,with-nil-entry)))) (package-initialize) (package-refresh-contents) @@ -634,8 +637,7 @@ Must called from within a `tar-mode' buffer." prog-alist))) (delete-directory homedir t)))) (let* ((keyring (expand-file-name "key.pub" package-test-data-dir)) - (package-test-data-dir - (expand-file-name "package-resources/signed" package-test-file-dir))) + (package-test-data-dir (ert-resource-file "signed"))) (with-package-test () (package-initialize) (package-import-keyring keyring) @@ -696,7 +698,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-x-test-upload-buffer () "Test creating an \"archive-contents\" file" - (with-package-test (:basedir "package-resources" + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) @@ -729,7 +731,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-x-test-upload-new-version () "Test uploading a new version of a package" - (with-package-test (:basedir "package-resources" + (with-package-test (:basedir (ert-resource-directory) :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 59d8c600a20..d2e11cf06aa 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -167,7 +167,11 @@ (let ((k "blue")) (should (equal (pcase "<blue>" ((rx "<" (literal k) ">") 'ok)) - 'ok)))) + 'ok))) + (should (equal (pcase "abc" + ((rx (? (let x alpha)) (?? (let y alnum)) ?c) + (list x y))) + '("a" "b")))) (ert-deftest rx-kleene () "Test greedy and non-greedy repetition operators." @@ -540,7 +544,7 @@ (ert-deftest rx-compat () "Test old symbol retained for compatibility (bug#37517)." (should (equal - (with-suppressed-warnings ((obsolete rx-submatch-n)) + (with-no-warnings (rx-submatch-n '(group-n 3 (+ nonl) eol))) "\\(?3:.+$\\)"))) diff --git a/test/lisp/emacs-lisp/shadow-tests.el b/test/lisp/emacs-lisp/shadow-tests.el index 219312a5578..5d6215ab6f3 100644 --- a/test/lisp/emacs-lisp/shadow-tests.el +++ b/test/lisp/emacs-lisp/shadow-tests.el @@ -20,30 +20,23 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'shadow) (eval-when-compile (require 'cl-lib)) -(defconst shadow-tests-data-directory - (expand-file-name "lisp/emacs-lisp/shadow-resources" - (or (getenv "EMACS_TEST_DIRECTORY") - (expand-file-name "../../.." - (or load-file-name - buffer-file-name)))) - "Directory for shadow test files.") - (ert-deftest shadow-case-insensitive () "Test shadowing for case insensitive filenames." ;; Override `file-name-case-insensitive-p' so we test the same thing ;; regardless of what file system we're running on. (cl-letf (((symbol-function 'file-name-case-insensitive-p) (lambda (_f) t))) - (should (equal (list (expand-file-name "p1/foo" shadow-tests-data-directory) - (expand-file-name "p2/FOO" shadow-tests-data-directory)) + (should (equal (list (ert-resource-file "p1/foo") + (ert-resource-file "p2/FOO")) (load-path-shadows-find - (list (expand-file-name "p1/" shadow-tests-data-directory) - (expand-file-name "p2/" shadow-tests-data-directory)))))) + (list (ert-resource-file "p1/") + (ert-resource-file "p2/")))))) (cl-letf (((symbol-function 'file-name-case-insensitive-p) (lambda (_f) nil))) (should-not (load-path-shadows-find - (list (expand-file-name "p1/" shadow-tests-data-directory) - (expand-file-name "p2/" shadow-tests-data-directory)))))) + (list (ert-resource-file "p1/") + (ert-resource-file "p2/")))))) ;;; shadow-tests.el ends here. diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el index 6870d49acb2..9e7a3bf31e3 100644 --- a/test/lisp/emacs-lisp/testcover-tests.el +++ b/test/lisp/emacs-lisp/testcover-tests.el @@ -31,26 +31,10 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'testcover) (require 'skeleton) -;; Use `eval-and-compile' around all these definitions because they're -;; used by the macro `testcover-tests-define-tests'. - -(eval-and-compile - (defvar testcover-tests-file-dir - (expand-file-name - "testcover-resources/" - (file-name-directory (or (bound-and-true-p byte-compile-current-file) - load-file-name - buffer-file-name))) - "Directory of the \"testcover-tests.el\" file.")) - -(eval-and-compile - (defvar testcover-tests-test-cases - (expand-file-name "testcases.el" testcover-tests-file-dir) - "File containing marked up code to instrument and check.")) - ;; Convert Testcover's overlays to plain text. (eval-and-compile @@ -62,6 +46,7 @@ is working correctly on a code sample. OPTARGS are optional arguments for `testcover-start'." (interactive "r") (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")) + (find-file-suppress-same-file-warnings t) (code (buffer-substring beg end)) (marked-up-code)) (unwind-protect @@ -114,7 +99,8 @@ arguments for `testcover-start'." (eval-and-compile (defun testcover-tests-run-test-case (marked-up-code) "Test the operation of Testcover on the string MARKED-UP-CODE." - (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))) + (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")) + (find-file-suppress-same-file-warnings t)) (unwind-protect (progn (with-temp-file tempfile @@ -149,7 +135,7 @@ Construct and return a list of `ert-deftest' forms. See testcases.el for documentation of the test definition format." (let (results) (with-temp-buffer - (insert-file-contents testcover-tests-test-cases) + (insert-file-contents (ert-resource-file "testcases.el")) (goto-char (point-min)) (while (re-search-forward (concat "^;; ==== \\([^ ]+?\\) ====\n" diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el b/test/lisp/emacs-lisp/text-property-search-tests.el index 83d4b95b76b..f643e49aa5e 100644 --- a/test/lisp/emacs-lisp/text-property-search-tests.el +++ b/test/lisp/emacs-lisp/text-property-search-tests.el @@ -153,6 +153,24 @@ 46 57 nil (point-max))) + +;;;; Position after search. + +(defun text-property-search--pos-test (fun pos &optional reverse) + (with-temp-buffer + (insert (concat "foo " + (propertize "bar" 'x t) + " baz")) + (goto-char (if reverse (point-max) (point-min))) + (funcall fun 'x t) + (should (= (point) pos)))) + +(ert-deftest text-property-search-forward-point-at-beginning () + (text-property-search--pos-test #'text-property-search-forward 5)) + +(ert-deftest text-property-search-backward-point-at-end () + (text-property-search--pos-test #'text-property-search-backward 8 t)) + (provide 'text-property-search-tests) ;;; text-property-search-tests.el ends here diff --git a/test/lisp/emacs-lisp/unsafep-tests.el b/test/lisp/emacs-lisp/unsafep-tests.el index 2b920a00ca4..06c40d28ca9 100644 --- a/test/lisp/emacs-lisp/unsafep-tests.el +++ b/test/lisp/emacs-lisp/unsafep-tests.el @@ -27,7 +27,7 @@ (defvar safe-functions) ;;; These forms are all considered safe -(defconst testcover-unsafep-safe +(defconst unsafep-tests--safe '(((lambda (x) (* x 2)) 14) (apply 'cdr (mapcar (lambda (x) (car x)) y)) (cond ((= x 4) 5) (t 27)) @@ -47,7 +47,7 @@ "List of forms that `unsafep' should decide are safe.") ;;; These forms are considered unsafe -(defconst testcover-unsafep-unsafe +(defconst unsafep-tests--unsafe '(( (add-to-list x y) . (unquoted x)) ( (add-to-list y x) @@ -105,26 +105,36 @@ . (variable (x))) ( (let (1) 2) . (variable 1)) + ( (error "asdf") + . #'error) + ( (signal 'error "asdf") + . #'signal) + ( (throw 'asdf) + . #'throw) + ( (catch 'asdf 17) + . #'catch) + ( (play-sound-file "asdf") + . #'play-sound-file) + ( (replace-regexp-in-string "a" "b") + . #'replace-regexp-in-string) ) - "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.") + "A-list of (FORM . REASON)... that `unsafep' should decide are unsafe.") (ert-deftest test-unsafep/safe () - "Executes all unsafep tests and displays the coverage results." + "Check safe forms with safe-functions nil." (let (safe-functions) - (dolist (x testcover-unsafep-safe) + (dolist (x unsafep-tests--safe) (should-not (unsafep x))))) (ert-deftest test-unsafep/message () - ;; FIXME: This failed after converting these tests from testcover to - ;; ert. - :expected-result :failed - (should-not '(dolist (x y) (message "here: %s" x))) - (should-not '(dotimes (x 14 (* x 2)) (message "here: %d" x)))) + "Check that message is considered unsafe." + (should (unsafep '(dolist (x y) (message "here: %s" x)))) + (should (unsafep '(dotimes (x 14 (* x 2)) (message "here: %d" x))))) (ert-deftest test-unsafep/unsafe () - "Executes all unsafep tests and displays the coverage results." + "Check unsafe forms with safe-functions nil." (let (safe-functions) - (dolist (x testcover-unsafep-unsafe) + (dolist (x unsafep-tests--unsafe) (should (equal (unsafep (car x)) (cdr x)))))) (ert-deftest test-unsafep/safe-functions-t () |