From 9bbe6eab6c160a454f2705c00ff3aea7f0c6e6c1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 18 Dec 2020 17:44:49 +0100 Subject: [PATCH] Fix native compiler tests when they are bytecompiled * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-test-ts) (comp-cstr-typespec-test, comp-cstr-typespec-tests-alist): Eval also at compile time. * test/src/comp-tests.el (comp-tests-type-spec-tests) (comp-tests-define-type-spec-test): Likewise. --- test/lisp/emacs-lisp/comp-cstr-tests.el | 350 ++++++++++++------------ test/src/comp-tests.el | 269 +++++++++--------- 2 files changed, 311 insertions(+), 308 deletions(-) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index b38573ca33a..834f4401d9f 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -29,180 +29,182 @@ (require 'cl-lib) (require 'comp-cstr) -(defun comp-cstr-test-ts (type-spec) - "Create a constraint from TYPE-SPEC and convert it back to type specifier." - (let ((comp-ctxt (make-comp-cstr-ctxt))) - (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec)))) - -(defun comp-cstr-typespec-test (number type-spec expected-type-spec) - `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) () - (should (equal (comp-cstr-test-ts ',type-spec) - ',expected-type-spec)))) - -(defconst comp-cstr-typespec-tests-alist - `(;; 1 - (symbol . symbol) - ;; 2 - ((or string array) . array) - ;; 3 - ((or symbol number) . (or number symbol)) - ;; 4 - ((or cons atom) . (or atom cons)) ;; SBCL return T - ;; 5 - ((or integer number) . number) - ;; 6 - ((or (or integer symbol) number) . (or number symbol)) - ;; 7 - ((or (or integer symbol) (or number list)) . (or list number symbol)) - ;; 8 - ((or (or integer number) nil) . number) - ;; 9 - ((member foo) . (member foo)) - ;; 10 - ((member foo bar) . (member bar foo)) - ;; 11 - ((or (member foo) (member bar)) . (member bar foo)) - ;; 12 - ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO)) - ;; 13 - ((or (member foo) number) . (or (member foo) number)) - ;; 14 - ((or (integer 1 3) number) . number) - ;; 15 - (integer . integer) - ;; 16 - ((integer 1 2) . (integer 1 2)) - ;; 17 - ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4))) - ;; 18 - ((or (integer -1 2) (integer 3 4)) . (integer -1 4)) - ;; 19 - ((or (integer -1 3) (integer 3 4)) . (integer -1 4)) - ;; 20 - ((or (integer -1 4) (integer 3 4)) . (integer -1 4)) - ;; 21 - ((or (integer -1 5) (integer 3 4)) . (integer -1 5)) - ;; 22 - ((or (integer -1 *) (integer 3 4)) . (integer -1 *)) - ;; 23 - ((or (integer -1 2) (integer * 4)) . (integer * 4)) - ;; 24 - ((and string array) . string) - ;; 25 - ((and cons atom) . nil) - ;; 26 - ((and (member foo) (member foo bar baz)) . (member foo)) - ;; 27 - ((and (member foo) (member bar)) . nil) - ;; 28 - ((and (member foo) symbol) . (member foo)) - ;; 29 - ((and (member foo) string) . nil) - ;; 30 - ((and (member foo) (integer 1 2)) . nil) - ;; 31 - ((and (member 1 2) (member 3 2)) . (member 2)) - ;; 32 - ((and number (integer 1 2)) . (integer 1 2)) - ;; 33 - ((and integer (integer 1 2)) . (integer 1 2)) - ;; 34 - ((and (integer -1 0) (integer 3 5)) . nil) - ;; 35 - ((and (integer -1 2) (integer 3 5)) . nil) - ;; 36 - ((and (integer -1 3) (integer 3 5)) . (integer 3 3)) - ;; 37 - ((and (integer -1 4) (integer 3 5)) . (integer 3 4)) - ;; 38 - ((and (integer -1 5) nil) . nil) - ;; 39 - ((not symbol) . (not symbol)) - ;; 40 - ((or (member foo) (not (member foo bar))) . (not (member bar))) - ;; 41 - ((or (member foo bar) (not (member foo))) . t) - ;; 42 - ((or symbol (not sequence)) . (not sequence)) - ;; 43 - ((or symbol (not symbol)) . t) - ;; 44 - ((or symbol (not sequence)) . (not sequence)) - ;; 45 Conservative. - ((or vector (not sequence)) . t) - ;; 46 - ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0))) - ;; 47 - ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0))) - ;; 48 - ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0)))) - ;; 49 - ((or symbol (not (member foo))) . (not (member foo))) - ;; 50 - ((or (not symbol) (not (member foo))) . (not symbol)) - ;; 51 Conservative. - ((or (not (member foo)) string) . (not (member foo))) - ;; 52 Conservative. - ((or (member foo) (not string)) . (not string)) - ;; 53 - ((or (not (integer 1 2)) integer) . integer) - ;; 54 - ((or (not (integer 1 2)) (not integer)) . (not integer)) - ;; 55 - ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *)))) - ;; 56 - ((or number (not (integer 1 2))) . t) - ;; 57 - ((or atom (not (integer 1 2))) . t) - ;; 58 - ((or atom (not (member foo))) . t) - ;; 59 - ((and symbol (not cons)) . symbol) - ;; 60 - ((and symbol (not symbol)) . nil) - ;; 61 - ((and atom (not symbol)) . atom) - ;; 62 - ((and atom (not string)) . (or array sequence atom)) - ;; 63 Conservative - ((and symbol (not (member foo))) . symbol) - ;; 64 Conservative - ((and symbol (not (member 3))) . symbol) - ;; 65 - ((and (not (member foo)) (integer 1 10)) . (integer 1 10)) - ;; 66 - ((and (member foo) (not (integer 1 10))) . (member foo)) - ;; 67 - ((and t (not (member foo))) . (not (member foo))) - ;; 68 - ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *))) - ;; 69 - ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20))) - ;; 70 - ((and (not (member a)) (not (member b))) . (not (member b a))) - ;; 71 - ((and (not boolean) (not (member b))) . (not (or (member b) boolean))) - ;; 72 - ((and t (integer 1 1)) . (integer 1 1)) - ;; 73 - ((not (integer -1 5)) . (not (integer -1 5))) - ;; 74 - ((and boolean (or number marker)) . nil) - ;; 75 - ((and atom (or number marker)) . (or marker number)) - ;; 76 - ((and symbol (or number marker)) . nil) - ;; 77 - ((and (or symbol string) (or number marker)) . nil) - ;; 78 - ((and t t) . t) - ;; 80 - ((and (or marker number) (integer 0 0)) . (integer 0 0)) - ;; 81 - ((and t (not t)) . nil) - ;; 82 - ((or (integer 1 1) (not (integer 1 1))) . t)) - "Alist type specifier -> expected type specifier.") +(cl-eval-when (compile eval load) + + (defun comp-cstr-test-ts (type-spec) + "Create a constraint from TYPE-SPEC and convert it back to type specifier." + (let ((comp-ctxt (make-comp-cstr-ctxt))) + (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec)))) + + (defun comp-cstr-typespec-test (number type-spec expected-type-spec) + `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) () + (should (equal (comp-cstr-test-ts ',type-spec) + ',expected-type-spec)))) + + (defconst comp-cstr-typespec-tests-alist + `(;; 1 + (symbol . symbol) + ;; 2 + ((or string array) . array) + ;; 3 + ((or symbol number) . (or number symbol)) + ;; 4 + ((or cons atom) . (or atom cons)) ;; SBCL return T + ;; 5 + ((or integer number) . number) + ;; 6 + ((or (or integer symbol) number) . (or number symbol)) + ;; 7 + ((or (or integer symbol) (or number list)) . (or list number symbol)) + ;; 8 + ((or (or integer number) nil) . number) + ;; 9 + ((member foo) . (member foo)) + ;; 10 + ((member foo bar) . (member bar foo)) + ;; 11 + ((or (member foo) (member bar)) . (member bar foo)) + ;; 12 + ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO)) + ;; 13 + ((or (member foo) number) . (or (member foo) number)) + ;; 14 + ((or (integer 1 3) number) . number) + ;; 15 + (integer . integer) + ;; 16 + ((integer 1 2) . (integer 1 2)) + ;; 17 + ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4))) + ;; 18 + ((or (integer -1 2) (integer 3 4)) . (integer -1 4)) + ;; 19 + ((or (integer -1 3) (integer 3 4)) . (integer -1 4)) + ;; 20 + ((or (integer -1 4) (integer 3 4)) . (integer -1 4)) + ;; 21 + ((or (integer -1 5) (integer 3 4)) . (integer -1 5)) + ;; 22 + ((or (integer -1 *) (integer 3 4)) . (integer -1 *)) + ;; 23 + ((or (integer -1 2) (integer * 4)) . (integer * 4)) + ;; 24 + ((and string array) . string) + ;; 25 + ((and cons atom) . nil) + ;; 26 + ((and (member foo) (member foo bar baz)) . (member foo)) + ;; 27 + ((and (member foo) (member bar)) . nil) + ;; 28 + ((and (member foo) symbol) . (member foo)) + ;; 29 + ((and (member foo) string) . nil) + ;; 30 + ((and (member foo) (integer 1 2)) . nil) + ;; 31 + ((and (member 1 2) (member 3 2)) . (member 2)) + ;; 32 + ((and number (integer 1 2)) . (integer 1 2)) + ;; 33 + ((and integer (integer 1 2)) . (integer 1 2)) + ;; 34 + ((and (integer -1 0) (integer 3 5)) . nil) + ;; 35 + ((and (integer -1 2) (integer 3 5)) . nil) + ;; 36 + ((and (integer -1 3) (integer 3 5)) . (integer 3 3)) + ;; 37 + ((and (integer -1 4) (integer 3 5)) . (integer 3 4)) + ;; 38 + ((and (integer -1 5) nil) . nil) + ;; 39 + ((not symbol) . (not symbol)) + ;; 40 + ((or (member foo) (not (member foo bar))) . (not (member bar))) + ;; 41 + ((or (member foo bar) (not (member foo))) . t) + ;; 42 + ((or symbol (not sequence)) . (not sequence)) + ;; 43 + ((or symbol (not symbol)) . t) + ;; 44 + ((or symbol (not sequence)) . (not sequence)) + ;; 45 Conservative. + ((or vector (not sequence)) . t) + ;; 46 + ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0))) + ;; 47 + ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0))) + ;; 48 + ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0)))) + ;; 49 + ((or symbol (not (member foo))) . (not (member foo))) + ;; 50 + ((or (not symbol) (not (member foo))) . (not symbol)) + ;; 51 Conservative. + ((or (not (member foo)) string) . (not (member foo))) + ;; 52 Conservative. + ((or (member foo) (not string)) . (not string)) + ;; 53 + ((or (not (integer 1 2)) integer) . integer) + ;; 54 + ((or (not (integer 1 2)) (not integer)) . (not integer)) + ;; 55 + ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *)))) + ;; 56 + ((or number (not (integer 1 2))) . t) + ;; 57 + ((or atom (not (integer 1 2))) . t) + ;; 58 + ((or atom (not (member foo))) . t) + ;; 59 + ((and symbol (not cons)) . symbol) + ;; 60 + ((and symbol (not symbol)) . nil) + ;; 61 + ((and atom (not symbol)) . atom) + ;; 62 + ((and atom (not string)) . (or array sequence atom)) + ;; 63 Conservative + ((and symbol (not (member foo))) . symbol) + ;; 64 Conservative + ((and symbol (not (member 3))) . symbol) + ;; 65 + ((and (not (member foo)) (integer 1 10)) . (integer 1 10)) + ;; 66 + ((and (member foo) (not (integer 1 10))) . (member foo)) + ;; 67 + ((and t (not (member foo))) . (not (member foo))) + ;; 68 + ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *))) + ;; 69 + ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20))) + ;; 70 + ((and (not (member a)) (not (member b))) . (not (member b a))) + ;; 71 + ((and (not boolean) (not (member b))) . (not (or (member b) boolean))) + ;; 72 + ((and t (integer 1 1)) . (integer 1 1)) + ;; 73 + ((not (integer -1 5)) . (not (integer -1 5))) + ;; 74 + ((and boolean (or number marker)) . nil) + ;; 75 + ((and atom (or number marker)) . (or marker number)) + ;; 76 + ((and symbol (or number marker)) . nil) + ;; 77 + ((and (or symbol string) (or number marker)) . nil) + ;; 78 + ((and t t) . t) + ;; 80 + ((and (or marker number) (integer 0 0)) . (integer 0 0)) + ;; 81 + ((and t (not t)) . nil) + ;; 82 + ((or (integer 1 1) (not (integer 1 1))) . t)) + "Alist type specifier -> expected type specifier.")) (defmacro comp-cstr-synthesize-tests () "Generate all tests from `comp-cstr-typespec-tests-alist'." diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index a3e887bde95..8e069fb3082 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -789,142 +789,143 @@ Return a list of results." (eval func-form t) (native-compile (cadr func-form)))) -(defconst comp-tests-type-spec-tests - `( - ;; 1 - ((defun comp-tests-ret-type-spec-f (x) - x) - t) - - ;; 2 - ((defun comp-tests-ret-type-spec-f () - 1) - (integer 1 1)) - - ;; 3 - ((defun comp-tests-ret-type-spec-f (x) - (if x 1 3)) - (or (integer 1 1) (integer 3 3))) - - ;; 4 - ((defun comp-tests-ret-type-spec-f (x) - (let (y) +(cl-eval-when (compile eval load) + (defconst comp-tests-type-spec-tests + `( + ;; 1 + ((defun comp-tests-ret-type-spec-f (x) + x) + t) + + ;; 2 + ((defun comp-tests-ret-type-spec-f () + 1) + (integer 1 1)) + + ;; 3 + ((defun comp-tests-ret-type-spec-f (x) + (if x 1 3)) + (or (integer 1 1) (integer 3 3))) + + ;; 4 + ((defun comp-tests-ret-type-spec-f (x) + (let (y) + (if x + (setf y 1) + (setf y 2)) + y)) + (integer 1 2)) + + ;; 5 + ((defun comp-tests-ret-type-spec-f (x) + (let (y) + (if x + (setf y 1) + (setf y 3)) + y)) + (or (integer 1 1) (integer 3 3))) + + + ;; 6 + ((defun comp-tests-ret-type-spec-f (x) (if x - (setf y 1) - (setf y 2)) - y)) - (integer 1 2)) - - ;; 5 - ((defun comp-tests-ret-type-spec-f (x) - (let (y) + (list x) + 3)) + (or cons (integer 3 3))) + + ;; 7 + ((defun comp-tests-ret-type-spec-f (x) (if x - (setf y 1) - (setf y 3)) - y)) - (or (integer 1 1) (integer 3 3))) - - - ;; 6 - ((defun comp-tests-ret-type-spec-f (x) - (if x - (list x) - 3)) - (or cons (integer 3 3))) - - ;; 7 - ((defun comp-tests-ret-type-spec-f (x) - (if x - 'foo - 3)) - (or (member foo) (integer 3 3))) - - ;; 8 - ((defun comp-tests-ret-type-spec-f (x) - (if (eq x 3) - x - 'foo)) - (or (member foo) (integer 3 3))) - - ;; 9 - ((defun comp-tests-ret-type-spec-f (x) - (if (eq 3 x) - x - 'foo)) - (or (member foo) (integer 3 3))) - - ;; 10 - ((defun comp-tests-ret-type-spec-f (x) - (if (= x 3) - x - 'foo)) - (or (member foo) (integer 3 3))) - - ;; 11 - ((defun comp-tests-ret-type-spec-f (x) - (if (= 3 x) - x - 'foo)) - (or (member foo) (integer 3 3))) - - ;; 12 - ((defun comp-tests-ret-type-spec-8-3-f (x) - (if (= x 3) - 'foo - x)) - (or (member foo) marker number)) - - ;; 13 - ((defun comp-tests-ret-type-spec-8-4-f (x y) - (if (= x y) - x - 'foo)) - (or (member foo) marker number)) - - ;; 14 - ((defun comp-tests-ret-type-spec-9-1-f (x) - (comp-hint-fixnum x)) - (integer ,most-negative-fixnum ,most-positive-fixnum)) - - ;; 15 - ((defun comp-tests-ret-type-spec-f (x) - (comp-hint-cons x)) - cons) - - ;; 16 - ((defun comp-tests-ret-type-spec-f (x) - (let (y) - (when x - (setf y 4)) - y)) - (or null (integer 4 4))) - - ;; 17 - ((defun comp-tests-ret-type-spec-f () - (let (x - (y 3)) - (setf x y) - y)) - (integer 3 3)) - - ;; 18 - ((defun comp-tests-ret-type-spec-f (x) - (let ((y 3)) - (when x - (setf y x)) - y)) - t) - - ;; 19 - ((defun comp-tests-ret-type-spec-f (x y) - (eq x y)) - boolean))) - -(defun comp-tests-define-type-spec-test (number x) - `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () - ,(format "Type specifier test number %d." number) - (let ((comp-ctxt (make-comp-cstr-ctxt))) - (comp-tests-check-ret-type-spec ',(car x) ',(cadr x))))) + 'foo + 3)) + (or (member foo) (integer 3 3))) + + ;; 8 + ((defun comp-tests-ret-type-spec-f (x) + (if (eq x 3) + x + 'foo)) + (or (member foo) (integer 3 3))) + + ;; 9 + ((defun comp-tests-ret-type-spec-f (x) + (if (eq 3 x) + x + 'foo)) + (or (member foo) (integer 3 3))) + + ;; 10 + ((defun comp-tests-ret-type-spec-f (x) + (if (= x 3) + x + 'foo)) + (or (member foo) (integer 3 3))) + + ;; 11 + ((defun comp-tests-ret-type-spec-f (x) + (if (= 3 x) + x + 'foo)) + (or (member foo) (integer 3 3))) + + ;; 12 + ((defun comp-tests-ret-type-spec-f (x) + (if (= x 3) + 'foo + x)) + (or (member foo) marker number)) + + ;; 13 + ((defun comp-tests-ret-type-spec-f (x y) + (if (= x y) + x + 'foo)) + (or (member foo) marker number)) + + ;; 14 + ((defun comp-tests-ret-type-spec-f (x) + (comp-hint-fixnum x)) + (integer ,most-negative-fixnum ,most-positive-fixnum)) + + ;; 15 + ((defun comp-tests-ret-type-spec-f (x) + (comp-hint-cons x)) + cons) + + ;; 16 + ((defun comp-tests-ret-type-spec-f (x) + (let (y) + (when x + (setf y 4)) + y)) + (or null (integer 4 4))) + + ;; 17 + ((defun comp-tests-ret-type-spec-f () + (let (x + (y 3)) + (setf x y) + y)) + (integer 3 3)) + + ;; 18 + ((defun comp-tests-ret-type-spec-f (x) + (let ((y 3)) + (when x + (setf y x)) + y)) + t) + + ;; 19 + ((defun comp-tests-ret-type-spec-f (x y) + (eq x y)) + boolean))) + + (defun comp-tests-define-type-spec-test (number x) + `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () + ,(format "Type specifier test number %d." number) + (let ((comp-ctxt (make-comp-cstr-ctxt))) + (comp-tests-check-ret-type-spec ',(car x) ',(cadr x)))))) (defmacro comp-tests-define-type-spec-tests () "Define all type specifier tests." -- 2.39.5