From: Andrea Corallo Date: Fri, 2 Oct 2020 07:52:40 +0000 (+0200) Subject: Clean-up testsuite for vanilla builds X-Git-Tag: emacs-28.0.90~2727^2~407 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f345622152786388f4689f81f91acabe6eab9500;p=emacs.git Clean-up testsuite for vanilla builds Tag all native compiler tests and skip them in vanilla builds * test/Makefile.in (SELECTOR_DEFAULT, SELECTOR_EXPENSIVE) (SELECTOR_ALL): Define selectors for vanilla or nativecomp builds. * test/src/comp-tests.el: Do not native compile test files on vanilla. (comp-deftest): New macro to define tests tagging as :nativecomp. --- diff --git a/test/Makefile.in b/test/Makefile.in index 9974eb54b03..4a5cbee8c86 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -70,6 +70,7 @@ am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) am__v_at_0 = @ am__v_at_1 = +HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change @@ -138,9 +139,15 @@ test_module_dir := data/emacs-module all: check +ifeq ($(HAVE_NATIVE_COMP),yes) SELECTOR_DEFAULT = (not (or (tag :expensive-test) (tag :unstable))) SELECTOR_EXPENSIVE = (not (tag :unstable)) SELECTOR_ALL = t +else +SELECTOR_DEFAULT = (not (or (tag :expensive-test) (tag :unstable) (tag :nativecomp))) +SELECTOR_EXPENSIVE = (not (or (tag :unstable) (tag :nativecomp))) +SELECTOR_ALL = (not (tag :nativecomp)) +endif ifdef SELECTOR SELECTOR_ACTUAL=$(SELECTOR) else ifndef MAKECMDGOALS diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index f76afdbf1ce..f954ae6a9dd 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -37,16 +37,25 @@ (defconst comp-test-dyn-src (concat comp-test-directory "comp-test-funcs-dyn.el")) -(message "Compiling tests...") -(load (native-compile comp-test-src)) -(load (native-compile comp-test-dyn-src)) +(when (boundp 'comp-ctxt) + (message "Compiling tests...") + (load (native-compile comp-test-src)) + (load (native-compile comp-test-dyn-src))) + +(defmacro comp-deftest (name args &rest docstring-and-body) + "Define a test for the native compiler tagging it as :nativecomp." + (declare (indent defun) + (doc-string 3)) + `(ert-deftest ,(intern (concat "compt-tests-" (symbol-name name))) ,args + :tags '(:nativecomp) + ,@docstring-and-body)) (ert-deftest comp-tests-bootstrap () "Compile the compiler and load it to compile it-self. Check that the resulting binaries do not differ." - :tags '(:expensive-test) + :tags '(:expensive-test :nativecomp) (let* ((comp-src (concat comp-test-directory "../../lisp/emacs-lisp/comp.el")) (comp1-src (make-temp-file "stage1-" nil ".el")) @@ -71,15 +80,15 @@ Check that the resulting binaries do not differ." (message "Comparing %s %s" comp1-eln comp2-eln) (should (= (call-process "cmp" nil nil nil comp1-eln comp2-eln) 0)))))) -(ert-deftest comp-tests-provide () +(comp-deftest provide () "Testing top level provide." (should (featurep 'comp-test-funcs))) -(ert-deftest comp-tests-varref () +(comp-deftest varref () "Testing varref." (should (= (comp-tests-varref-f) 3))) -(ert-deftest comp-tests-list () +(comp-deftest list () "Testing cons car cdr." (should (equal (comp-tests-list-f) '(1 2 3))) (should (equal (comp-tests-list2-f 1 2 3) '(1 2 3))) @@ -96,12 +105,12 @@ Check that the resulting binaries do not differ." (should (= (comp-tests-cdr-safe-f '(1 . 2)) 2)) (should (null (comp-tests-cdr-safe-f 'a)))) -(ert-deftest comp-tests-cons-car-cdr () +(comp-deftest comp-tests-cons-car-cdr () "Testing cons car cdr." (should (= (comp-tests-cons-car-f) 1)) (should (= (comp-tests-cons-cdr-f 3) 3))) -(ert-deftest comp-tests-varset () +(comp-deftest varset () "Testing varset." (comp-tests-varset0-f) (should (= comp-tests-var1 55)) @@ -109,23 +118,23 @@ Check that the resulting binaries do not differ." (should (= (comp-tests-varset1-f) 4)) (should (= comp-tests-var1 66))) -(ert-deftest comp-tests-length () +(comp-deftest length () "Testing length." (should (= (comp-tests-length-f) 3))) -(ert-deftest comp-tests-aref-aset () +(comp-deftest aref-aset () "Testing aref and aset." (should (= (comp-tests-aref-aset-f) 100))) -(ert-deftest comp-tests-symbol-value () +(comp-deftest symbol-value () "Testing aref and aset." (should (= (comp-tests-symbol-value-f) 3))) -(ert-deftest comp-tests-concat () +(comp-deftest concat () "Testing concatX opcodes." (should (string= (comp-tests-concat-f "bar") "abcdabcabfoobar"))) -(ert-deftest comp-tests-ffuncall () +(comp-deftest ffuncall () "Test calling conventions." ;; (defun comp-tests-ffuncall-caller-f () @@ -171,7 +180,7 @@ Check that the resulting binaries do not differ." (should (= (comp-tests-ffuncall-lambda-f 1) 2))) -(ert-deftest comp-tests-jump-table () +(comp-deftest jump-table () "Testing jump tables" (should (eq (comp-tests-jump-table-1-f 'x) 'a)) (should (eq (comp-tests-jump-table-1-f 'y) 'b)) @@ -181,14 +190,14 @@ Check that the resulting binaries do not differ." (should (eq (comp-tests-jump-table-2-f "aaa") 'a)) (should (eq (comp-tests-jump-table-2-f "bbb") 'b))) -(ert-deftest comp-tests-conditionals () +(comp-deftest conditionals () "Testing conditionals." (should (= (comp-tests-conditionals-1-f t) 1)) (should (= (comp-tests-conditionals-1-f nil) 2)) (should (= (comp-tests-conditionals-2-f t) 1340)) (should (eq (comp-tests-conditionals-2-f nil) nil))) -(ert-deftest comp-tests-fixnum () +(comp-deftest fixnum () "Testing some fixnum inline operation." (should (= (comp-tests-fixnum-1-minus-f 10) 9)) (should (= (comp-tests-fixnum-1-minus-f most-negative-fixnum) @@ -206,13 +215,13 @@ Check that the resulting binaries do not differ." (should-error (comp-tests-fixnum-minus-f 'a) :type 'wrong-type-argument)) -(ert-deftest comp-tests-type-hints () +(comp-deftest type-hints () "Just test compiler hints are transparent in this case." ;; FIXME we should really check they are also effective. (should (= (comp-tests-hint-fixnum-f 3) 4)) (should (= (comp-tests-hint-cons-f (cons 1 2)) 1))) -(ert-deftest comp-tests-arith-comp () +(comp-deftest arith-comp () "Testing arithmetic comparisons." (should (eq (comp-tests-eqlsign-f 4 3) nil)) (should (eq (comp-tests-eqlsign-f 3 3) t)) @@ -230,7 +239,7 @@ Check that the resulting binaries do not differ." (should (eq (comp-tests-geq-f 3 3) t)) (should (eq (comp-tests-geq-f 2 3) nil))) -(ert-deftest comp-tests-setcarcdr () +(comp-deftest setcarcdr () "Testing setcar setcdr." (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10))) (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3))) @@ -239,14 +248,14 @@ Check that the resulting binaries do not differ." (should-error (comp-tests-setcdr-f 3 10) :type 'wrong-type-argument)) -(ert-deftest comp-tests-bubble-sort () +(comp-deftest bubble-sort () "Run bubble sort." (let* ((list1 (mapcar #'random (make-list 1000 most-positive-fixnum))) (list2 (copy-sequence list1))) (should (equal (comp-bubble-sort-f list1) (sort list2 #'<))))) -(ert-deftest comp-test-apply () +(comp-deftest apply () "Test some inlined list functions." (should (eq (comp-tests-consp-f '(1)) t)) (should (eq (comp-tests-consp-f 1) nil)) @@ -254,7 +263,7 @@ Check that the resulting binaries do not differ." (should (= (comp-tests-setcar2-f x) 3)) (should (equal x '(3 . 2))))) -(ert-deftest comp-tests-num-inline () +(comp-deftest num-inline () "Test some inlined number functions." (should (eq (comp-tests-integerp-f 1) t)) (should (eq (comp-tests-integerp-f '(1)) nil)) @@ -265,7 +274,7 @@ Check that the resulting binaries do not differ." (should (eq (comp-tests-numberp-f 'a) nil)) (should (eq (comp-tests-numberp-f 3.5) t))) -(ert-deftest comp-tests-stack () +(comp-deftest stack () "Test some stack operation." (should (= (comp-tests-discardn-f 10) 2)) (should (string= (with-temp-buffer @@ -273,7 +282,7 @@ Check that the resulting binaries do not differ." (buffer-string)) "abcd"))) -(ert-deftest comp-tests-non-locals () +(comp-deftest non-locals () "Test non locals." (should (string= (comp-tests-condition-case-0-f) "arith-error Arithmetic error catched")) @@ -285,53 +294,53 @@ Check that the resulting binaries do not differ." (should (= (catch 'foo (comp-tests-throw-f 3))))) -(ert-deftest comp-tests-gc () +(comp-deftest gc () "Try to do some longer computation to let the gc kick in." (dotimes (_ 100000) (comp-tests-cons-cdr-f 3)) (should (= (comp-tests-cons-cdr-f 3) 3))) -(ert-deftest comp-tests-buffer () +(comp-deftest buffer () (should (string= (comp-tests-buff0-f) "foo"))) -(ert-deftest comp-tests-lambda-return () +(comp-deftest lambda-return () (let ((f (comp-tests-lambda-return-f))) (should (subr-native-elisp-p f)) (should (= (funcall f 3) 4)))) -(ert-deftest comp-tests-recursive () +(comp-deftest recursive () (should (= (comp-tests-fib-f 10) 55))) -(ert-deftest comp-tests-macro () +(comp-deftest macro () "Just check we can define macros" (should (macrop (symbol-function 'comp-tests-macro-m)))) -(ert-deftest comp-tests-string-trim () +(comp-deftest string-trim () (should (string= (comp-tests-string-trim-f "dsaf ") "dsaf"))) -(ert-deftest comp-tests-trampoline-removal () +(comp-deftest trampoline-removal () ;; This tests that we can can call primitives with no dedicated bytecode. ;; At speed >= 2 the trampoline will not be used. (should (hash-table-p (comp-tests-trampoline-removal-f)))) -(ert-deftest comp-tests-signal () +(comp-deftest signal () (should (equal (condition-case err (comp-tests-signal-f) (t err)) '(foo . t)))) -(ert-deftest comp-tests-func-call-removal () +(comp-deftest func-call-removal () ;; See `comp-propagate-insn' `comp-function-call-remove'. (should (= (comp-tests-func-call-removal-f) 1))) -(ert-deftest comp-tests-doc () +(comp-deftest doc () (should (string= (documentation #'comp-tests-doc-f) "A nice docstring")) ;; Check a preloaded function, we can't use `comp-tests-doc-f' now ;; as this is loaded manually with no .elc. (should (string-match "\\.*.elc\\'" (symbol-file #'error)))) -(ert-deftest comp-test-interactive-form () +(comp-deftest interactive-form () (should (equal (interactive-form #'comp-test-interactive-form0-f) '(interactive "D"))) (should (equal (interactive-form #'comp-test-interactive-form1-f) @@ -343,7 +352,7 @@ Check that the resulting binaries do not differ." comp-test-interactive-form2-f))) (should-not (commandp #'comp-tests-doc-f))) -(ert-deftest comp-tests-free-fun () +(comp-deftest free-fun () "Check we are able to compile a single function." (eval '(defun comp-tests-free-fun-f () "Some doc." @@ -360,24 +369,24 @@ Check that the resulting binaries do not differ." (should (equal (interactive-form #'comp-tests-free-fun-f) '(interactive)))) -(ert-deftest comp-test-40187 () +(comp-deftest bug-40187 () "Check function name shadowing. https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should (eq (comp-test-40187-1-f) 'foo)) (should (eq (comp-test-40187-2-f) 'bar))) -(ert-deftest comp-test-speed--1 () +(comp-deftest speed--1 () "Check that at speed -1 we do not native compile." (should (= (comp-test-speed--1-f) 3)) (should-not (subr-native-elisp-p (symbol-function #'comp-test-speed--1-f)))) -(ert-deftest comp-test-42360 () +(comp-deftest bug-42360 () "." (should (string= (comp-test-42360-f "Nel mezzo del " 18 0 32 "yyy" nil) "Nel mezzo del yyy"))) (defvar comp-test-primitive-advice) -(ert-deftest comp-test-primitive-advice () +(comp-deftest primitive-advice () "Test effectiveness of primitve advicing." (let (comp-test-primitive-advice (f (lambda (&rest args) @@ -394,65 +403,65 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." ;; Tromey's tests. ;; ;;;;;;;;;;;;;;;;;;;;; -(ert-deftest comp-consp () +(comp-deftest consp () (should-not (comp-test-consp 23)) (should-not (comp-test-consp nil)) (should (comp-test-consp '(1 . 2)))) -(ert-deftest comp-listp () +(comp-deftest listp () (should-not (comp-test-listp 23)) (should (comp-test-listp nil)) (should (comp-test-listp '(1 . 2)))) -(ert-deftest comp-stringp () +(comp-deftest stringp () (should-not (comp-test-stringp 23)) (should-not (comp-test-stringp nil)) (should (comp-test-stringp "hi"))) -(ert-deftest comp-symbolp () +(comp-deftest symbolp () (should-not (comp-test-symbolp 23)) (should-not (comp-test-symbolp "hi")) (should (comp-test-symbolp 'whatever))) -(ert-deftest comp-integerp () +(comp-deftest integerp () (should (comp-test-integerp 23)) (should-not (comp-test-integerp 57.5)) (should-not (comp-test-integerp "hi")) (should-not (comp-test-integerp 'whatever))) -(ert-deftest comp-numberp () +(comp-deftest numberp () (should (comp-test-numberp 23)) (should (comp-test-numberp 57.5)) (should-not (comp-test-numberp "hi")) (should-not (comp-test-numberp 'whatever))) -(ert-deftest comp-add1 () +(comp-deftest add1 () (should (eq (comp-test-add1 23) 24)) (should (eq (comp-test-add1 -17) -16)) (should (eql (comp-test-add1 1.0) 2.0)) (should-error (comp-test-add1 nil) :type 'wrong-type-argument)) -(ert-deftest comp-sub1 () +(comp-deftest sub1 () (should (eq (comp-test-sub1 23) 22)) (should (eq (comp-test-sub1 -17) -18)) (should (eql (comp-test-sub1 1.0) 0.0)) (should-error (comp-test-sub1 nil) :type 'wrong-type-argument)) -(ert-deftest comp-negate () +(comp-deftest negate () (should (eq (comp-test-negate 23) -23)) (should (eq (comp-test-negate -17) 17)) (should (eql (comp-test-negate 1.0) -1.0)) (should-error (comp-test-negate nil) :type 'wrong-type-argument)) -(ert-deftest comp-not () +(comp-deftest not () (should (eq (comp-test-not 23) nil)) (should (eq (comp-test-not nil) t)) (should (eq (comp-test-not t) nil))) -(ert-deftest comp-bobp-and-eobp () +(comp-deftest bobp-and-eobp () (with-temp-buffer (should (comp-test-bobp)) (should (comp-test-eobp)) @@ -468,7 +477,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should-not (comp-test-bobp)) (should (comp-test-eobp)))) -(ert-deftest comp-car-cdr () +(comp-deftest car-cdr () (let ((pair '(1 . b))) (should (eq (comp-test-car pair) 1)) (should (eq (comp-test-car nil) nil)) @@ -479,7 +488,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should-error (comp-test-cdr 23) :type 'wrong-type-argument))) -(ert-deftest comp-car-cdr-safe () +(comp-deftest car-cdr-safe () (let ((pair '(1 . b))) (should (eq (comp-test-car-safe pair) 1)) (should (eq (comp-test-car-safe nil) nil)) @@ -488,59 +497,59 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should (eq (comp-test-cdr-safe nil) nil)) (should (eq (comp-test-cdr-safe 23) nil)))) -(ert-deftest comp-eq () +(comp-deftest eq () (should (comp-test-eq 'a 'a)) (should (comp-test-eq 5 5)) (should-not (comp-test-eq 'a 'b))) -(ert-deftest comp-if () +(comp-deftest if () (should (eq (comp-test-if 'a 'b) 'a)) (should (eq (comp-test-if 0 23) 0)) (should (eq (comp-test-if nil 'b) 'b))) -(ert-deftest comp-and () +(comp-deftest and () (should (eq (comp-test-and 'a 'b) 'b)) (should (eq (comp-test-and 0 23) 23)) (should (eq (comp-test-and nil 'b) nil))) -(ert-deftest comp-or () +(comp-deftest or () (should (eq (comp-test-or 'a 'b) 'a)) (should (eq (comp-test-or 0 23) 0)) (should (eq (comp-test-or nil 'b) 'b))) -(ert-deftest comp-save-excursion () +(comp-deftest save-excursion () (with-temp-buffer (comp-test-save-excursion) (should (eq (point) (point-min))) (should (eq (comp-test-current-buffer) (current-buffer))))) -(ert-deftest comp-> () +(comp-deftest > () (should (eq (comp-test-> 0 23) nil)) (should (eq (comp-test-> 23 0) t))) -(ert-deftest comp-catch () +(comp-deftest catch () (should (eq (comp-test-catch 0 1 2 3 4) nil)) (should (eq (comp-test-catch 20 21 22 23 24 25 26 27 28) 24))) -(ert-deftest comp-memq () +(comp-deftest memq () (should (equal (comp-test-memq 0 '(5 4 3 2 1 0)) '(0))) (should (eq (comp-test-memq 72 '(5 4 3 2 1 0)) nil))) -(ert-deftest comp-listN () +(comp-deftest listN () (should (equal (comp-test-listN 57) '(57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57)))) -(ert-deftest comp-concatN () +(comp-deftest concatN () (should (equal (comp-test-concatN "x") "xxxxxx"))) -(ert-deftest comp-opt-rest () +(comp-deftest opt-rest () (should (equal (comp-test-opt-rest 1) '(1 nil nil))) (should (equal (comp-test-opt-rest 1 2) '(1 2 nil))) (should (equal (comp-test-opt-rest 1 2 3) '(1 2 (3)))) (should (equal (comp-test-opt-rest 1 2 56 57 58) '(1 2 (56 57 58))))) -(ert-deftest comp-opt () +(comp-deftest opt () (should (equal (comp-test-opt 23) '(23))) (should (equal (comp-test-opt 23 24) '(23 . 24))) (should-error (comp-test-opt) @@ -548,7 +557,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should-error (comp-test-opt nil 24 97) :type 'wrong-number-of-arguments)) -(ert-deftest comp-unwind-protect () +(comp-deftest unwind-protect () (comp-test-unwind-protect 'ignore) (should (eq comp-test-up-val 999)) (condition-case nil @@ -562,7 +571,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." ;; Tests for dynamic scope. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(ert-deftest comp-tests-dynamic-ffuncall () +(comp-deftest dynamic-ffuncall () "Test calling convention for dynamic binding." (should (equal (comp-tests-ffuncall-callee-dyn-f 1 2) @@ -589,7 +598,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should (equal (comp-tests-ffuncall-callee-opt-rest-dyn-f 1 2 3 4) '(1 2 3 (4))))) -(ert-deftest comp-tests-dynamic-arity () +(comp-deftest dynamic-arity () "Test func-arity on dynamic scope functions." (should (equal '(2 . 2) (func-arity #'comp-tests-ffuncall-callee-dyn-f))) @@ -600,18 +609,18 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should (equal '(2 . many) (func-arity #'comp-tests-ffuncall-callee-opt-rest-dyn-f)))) -(ert-deftest comp-tests-dynamic-help-arglist () +(comp-deftest dynamic-help-arglist () "Test `help-function-arglist' works on lisp/d (bug#42572)." (should (equal (help-function-arglist (symbol-function #'comp-tests-ffuncall-callee-opt-rest-dyn-f) t) '(a b &optional c &rest d)))) -(ert-deftest comp-tests-cl-macro-exp () +(comp-deftest cl-macro-exp () "Verify CL macro expansion (bug#42088)." (should (equal (comp-tests-cl-macro-exp-f) '(a b)))) -(ert-deftest comp-tests-cl-uninterned-arg-parse-f () +(comp-deftest cl-uninterned-arg-parse-f () "Verify the parsing of a lambda list with uninterned symbols (bug#42120)." (should (equal (comp-tests-cl-uninterned-arg-parse-f 1 2) '(1 2)))) @@ -659,7 +668,7 @@ CHECKER should always return nil to have a pass." (comp-tests-mentioned-p (comp-c-func-name 'comp-tests-tco-f "F" t) insn))))) -(ert-deftest comp-tests-tco () +(comp-deftest tco () "Check for tail recursion elimination." (let ((comp-speed 3) ;; Disable ipa-pure otherwise `comp-tests-tco-f' gets @@ -684,7 +693,7 @@ CHECKER should always return nil to have a pass." (or (comp-tests-mentioned-p 'concat insn) (comp-tests-mentioned-p 'length insn))))) -(ert-deftest comp-tests-fw-prop () +(comp-deftest fw-prop () "Some tests for forward propagation." (let ((comp-speed 2) (comp-post-pass-hooks '((comp-final comp-tests-fw-prop-checker-1)))) @@ -717,7 +726,7 @@ CHECKER should always return nil to have a pass." (comp-tests-mentioned-p (comp-c-func-name 'comp-tests-pure-fibn-f "F" t) insn))))) -(ert-deftest comp-tests-pure () +(comp-deftest pure () "Some tests for pure functions optimization." (let ((comp-speed 3) (comp-post-pass-hooks '((comp-final comp-tests-pure-checker-1