emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/native-comp 9bbe6ea 15/19: Fix native compiler tests when they a


From: Andrea Corallo
Subject: feature/native-comp 9bbe6ea 15/19: Fix native compiler tests when they are bytecompiled
Date: Mon, 21 Dec 2020 14:52:41 -0500 (EST)

branch: feature/native-comp
commit 9bbe6eab6c160a454f2705c00ff3aea7f0c6e6c1
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    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 b38573c..834f440 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 a3e887b..8e069fb 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."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]