rework tests

1 files changed, 126 insertions, 157 deletions

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 332dd3f8c0f..e959e265228 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -27,19 +27,42 @@
 
 (require 'ert)
 (require 'comp)
+;; (require 'cl-lib)
 
-(setq garbage-collection-messages t)
+(defun comp-test-apply (func &rest args)
+  (unless (subrp (symbol-function func))
+    (native-compile func))
+  (apply func args))
+
+(defun comp-mashup (&rest args)
+  "Mash-up ARGS and return a symbol."
+  (intern (apply #'concat
+                 (mapcar (lambda (x)
+                           (cl-etypecase x
+                             (symbol (symbol-name x))
+                             (string x)))
+                         args))))
+
+;; (setq garbage-collection-messages t)
 
 (defvar comp-tests-var1 3)
 
-(ert-deftest  comp-tests-varref ()
+;; (defmacro comp-ert-deftest (name &rest body)
+;;   (declare (indent defun))
+;;   `(progn
+;;      ,@(cl-loop for speed from 0 to 3
+;;                 for test-name = (comp-mashup name "-speed-"
+;;                                              (number-to-string speed))
+;;                 collect `(ert-deftest ,test-name ()
+;;                            (let ((comp-speed ,speed))
+;;                              ,body)))))
+
+(ert-deftest comp-tests-varref ()
   "Testing varref."
   (defun comp-tests-varref-f ()
     comp-tests-var1)
 
-  (native-compile #'comp-tests-varref-f)
-
-  (should (= (comp-tests-varref-f) 3)))
+  (should (= (comp-test-apply #'comp-tests-varref-f) 3)))
 
 (ert-deftest comp-tests-list ()
   "Testing cons car cdr."
@@ -60,52 +83,42 @@
     ;; Bcdr_safe
     (cdr-safe x))
 
-  (native-compile #'comp-tests-list-f)
-  (native-compile #'comp-tests-list2-f)
-  (native-compile #'comp-tests-car-f)
-  (native-compile #'comp-tests-cdr-f)
-  (native-compile #'comp-tests-car-safe-f)
-  (native-compile #'comp-tests-cdr-safe-f)
-
-  (should (equal (comp-tests-list-f) '(1 2 3)))
-  (should (equal (comp-tests-list2-f 1 2 3) '(1 2 3)))
-  (should (= (comp-tests-car-f '(1 . 2)) 1))
-  (should (null (comp-tests-car-f nil)))
+  (should (equal (comp-test-apply #'comp-tests-list-f) '(1 2 3)))
+  (should (equal (comp-test-apply #'comp-tests-list2-f 1 2 3) '(1 2 3)))
+  (should (= (comp-test-apply #'comp-tests-car-f '(1 . 2)) 1))
+  (should (null (comp-test-apply #'comp-tests-car-f nil)))
   (should (= (condition-case err
-                 (comp-tests-car-f 3)
+                 (comp-test-apply #'comp-tests-car-f 3)
                (error 10))
              10))
-  (should (= (comp-tests-cdr-f '(1 . 2)) 2))
-  (should (null (comp-tests-cdr-f nil)))
+  (should (= (comp-test-apply #'comp-tests-cdr-f '(1 . 2)) 2))
+  (should (null (comp-test-apply #'comp-tests-cdr-f nil)))
   (should (= (condition-case err
-                 (comp-tests-cdr-f 3)
+                 (comp-test-apply #'comp-tests-cdr-f 3)
                (error 10))
              10))
-  (should (= (comp-tests-car-safe-f '(1 . 2)) 1))
-  (should (null (comp-tests-car-safe-f 'a)))
-  (should (= (comp-tests-cdr-safe-f '(1 . 2)) 2))
-  (should (null (comp-tests-cdr-safe-f 'a))))
+  (should (= (comp-test-apply #'comp-tests-car-safe-f '(1 . 2)) 1))
+  (should (null (comp-test-apply #'comp-tests-car-safe-f 'a)))
+  (should (= (comp-test-apply #'comp-tests-cdr-safe-f '(1 . 2)) 2))
+  (should (null (comp-test-apply #'comp-tests-cdr-safe-f 'a))))
 
 (ert-deftest  comp-tests-cons-car-cdr ()
   "Testing cons car cdr."
   (defun comp-tests-cons-car-f ()
     (car (cons 1 2)))
-  (native-compile #'comp-tests-cons-car-f)
 
   (defun comp-tests-cons-cdr-f (x)
     (cdr (cons 'foo x)))
-  (native-compile #'comp-tests-cons-cdr-f)
 
-  (should (= (comp-tests-cons-car-f) 1))
-  (should (= (comp-tests-cons-cdr-f 3) 3)))
+  (should (= (comp-test-apply #'comp-tests-cons-car-f) 1))
+  (should (= (comp-test-apply #'comp-tests-cons-cdr-f 3) 3)))
 
 (ert-deftest comp-tests-varset ()
   "Testing varset."
   (defun comp-tests-varset-f ()
       (setq comp-tests-var1 55))
-  (native-compile #'comp-tests-varset-f)
 
-  (comp-tests-varset-f)
+  (comp-test-apply #'comp-tests-varset-f)
 
   (should (= comp-tests-var1 55)))
 
@@ -113,98 +126,91 @@
   "Testing length."
   (defun comp-tests-length-f ()
       (length '(1 2 3)))
-  (native-compile #'comp-tests-length-f)
 
-  (should (= (comp-tests-length-f) 3)))
+  (should (= (comp-test-apply #'comp-tests-length-f) 3)))
 
-(ert-deftest  comp-tests-aref-aset ()
+(ert-deftest comp-tests-aref-aset ()
   "Testing aref and aset."
   (defun comp-tests-aref-aset-f ()
     (let ((vec [1 2 3]))
       (aset vec 2 100)
       (aref vec 2)))
-  (native-compile #'comp-tests-aref-aset-f)
 
-  (should (= (comp-tests-aref-aset-f) 100)))
+  (should (= (comp-test-apply #'comp-tests-aref-aset-f) 100)))
 
-(ert-deftest  comp-tests-symbol-value ()
+(ert-deftest comp-tests-symbol-value ()
   "Testing aref and aset."
   (defvar comp-tests-var2 3)
   (defun comp-tests-symbol-value-f ()
     (symbol-value 'comp-tests-var2))
-  (native-compile #'comp-tests-symbol-value-f)
 
-  (should (= (comp-tests-symbol-value-f) 3)))
+  (should (= (comp-test-apply #'comp-tests-symbol-value-f) 3)))
 
-(ert-deftest  comp-tests-concat ()
+(ert-deftest comp-tests-concat ()
   "Testing concatX opcodes."
   (defun comp-tests-concat-f (x)
     (concat "a" "b" "c" "d"
             (concat "a" "b" "c" (concat "a" "b" (concat "foo" x)))))
-  (native-compile #'comp-tests-concat-f)
 
-  (should (string= (comp-tests-concat-f "bar") "abcdabcabfoobar")))
+  (should (string= (comp-test-apply #'comp-tests-concat-f "bar") "abcdabcabfoobar")))
 
-(ert-deftest  comp-tests-ffuncall ()
-  "Test calling conventions."
-  (defun comp-tests-ffuncall-callee-f (x y z)
+(defun comp-tests-ffuncall-callee-f (x y z)
     (list x y z))
+
+(ert-deftest comp-tests-ffuncall ()
+  "Test calling conventions."
+  (native-compile #'comp-tests-ffuncall-calle-f)
   (defun comp-tests-ffuncall-caller-f ()
     (comp-tests-ffuncall-callee-f 1 2 3))
 
-  (native-compile #'comp-tests-ffuncall-caller-f)
-
-  (should (equal (comp-tests-ffuncall-caller-f) '(1 2 3)))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-caller-f) '(1 2 3)))
 
   (defun comp-tests-ffuncall-callee-optional-f (a b &optional c d)
     (list a b c d))
-  (native-compile #'comp-tests-ffuncall-callee-optional-f)
 
-  (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3 4) '(1 2 3 4)))
-  (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3) '(1 2 3 nil)))
-  (should (equal (comp-tests-ffuncall-callee-optional-f 1 2) '(1 2 nil nil)))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-callee-optional-f 1 2 3 4)
+                 '(1 2 3 4)))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-callee-optional-f 1 2 3)
+                 '(1 2 3 nil)))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-callee-optional-f 1 2)
+                 '(1 2 nil nil)))
 
   (defun comp-tests-ffuncall-callee-rest-f (a b &rest c)
     (list a b c))
-  (native-compile #'comp-tests-ffuncall-callee-rest-f)
 
-  (should (equal (comp-tests-ffuncall-callee-rest-f 1 2) '(1 2 nil)))
-  (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3) '(1 2 (3))))
-  (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3 4) '(1 2 (3 4))))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-callee-rest-f 1 2)
+                 '(1 2 nil)))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-callee-rest-f 1 2 3)
+                 '(1 2 (3))))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-callee-rest-f 1 2 3 4)
+                 '(1 2 (3 4))))
 
   (defun comp-tests-ffuncall-native-f ()
     "Call a primitive with no dedicate op."
     (make-vector 1 nil))
 
-  (native-compile #'comp-tests-ffuncall-native-f)
-
-  (should (equal (comp-tests-ffuncall-native-f) [nil]))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-native-f) [nil]))
 
   (defun comp-tests-ffuncall-native-rest-f ()
     "Call a primitive with no dedicate op with &rest."
     (vector 1 2 3))
 
-  (native-compile #'comp-tests-ffuncall-native-rest-f)
-
-  (should (equal (comp-tests-ffuncall-native-rest-f) [1 2 3]))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-native-rest-f) [1 2 3]))
 
   (defun comp-tests-ffuncall-apply-many-f (x)
     (apply #'list x))
 
-  (native-compile #'comp-tests-ffuncall-apply-many-f)
-
-  (should (equal (comp-tests-ffuncall-apply-many-f '(1 2 3)) '(1 2 3)))
+  (should (equal (comp-test-apply #'comp-tests-ffuncall-apply-many-f '(1 2 3))
+                 '(1 2 3)))
 
   (defun comp-tests-ffuncall-lambda-f (x)
     (let ((fun (lambda (x)
                  (1+ x))))
       (funcall fun x)))
 
-  (native-compile #'comp-tests-ffuncall-lambda-f)
-
-  (should (= (comp-tests-ffuncall-lambda-f 1) 2)))
+  (should (= (comp-test-apply #'comp-tests-ffuncall-lambda-f 1) 2)))
 
-(ert-deftest  comp-tests-jump-table ()
+(ert-deftest comp-tests-jump-table ()
   "Testing jump tables"
   (defun comp-tests-jump-table-1-f (x)
     (pcase x
@@ -212,13 +218,11 @@
       ('y 'b)
       (_ 'c)))
 
-  (native-compile #'comp-tests-jump-table-1-f)
+  (should (eq (comp-test-apply #'comp-tests-jump-table-1-f 'x) 'a))
+  (should (eq (comp-test-apply #'comp-tests-jump-table-1-f 'y) 'b))
+  (should (eq (comp-test-apply #'comp-tests-jump-table-1-f 'xxx) 'c)))
 
-  (should (eq (comp-tests-jump-table-1-f 'x) 'a))
-  (should (eq (comp-tests-jump-table-1-f 'y) 'b))
-  (should (eq (comp-tests-jump-table-1-f 'xxx) 'c)))
-
-(ert-deftest  comp-tests-conditionals ()
+(ert-deftest comp-tests-conditionals ()
   "Testing conditionals."
   (defun comp-tests-conditionals-1-f (x)
     ;; Generate goto-if-nil
@@ -227,15 +231,13 @@
     ;; Generate goto-if-nil-else-pop
     (when x
       1340))
-  (native-compile #'comp-tests-conditionals-1-f)
-  (native-compile #'comp-tests-conditionals-2-f)
 
-  (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)))
+  (should (= (comp-test-apply #'comp-tests-conditionals-1-f t) 1))
+  (should (= (comp-test-apply #'comp-tests-conditionals-1-f nil) 2))
+  (should (= (comp-test-apply #'comp-tests-conditionals-2-f t) 1340))
+  (should (eq (comp-test-apply #'comp-tests-conditionals-2-f nil) nil)))
 
-(ert-deftest  comp-tests-fixnum ()
+(ert-deftest comp-tests-fixnum ()
   "Testing some fixnum inline operation."
   (defun comp-tests-fixnum-1-minus-f (x)
     ;; Bsub1
@@ -247,33 +249,29 @@
     ;; Bnegate
     (- x))
 
-  (native-compile #'comp-tests-fixnum-1-minus-f)
-  (native-compile #'comp-tests-fixnum-1-plus-f)
-  (native-compile #'comp-tests-fixnum-minus-f)
-
-  (should (= (comp-tests-fixnum-1-minus-f 10) 9))
-  (should (= (comp-tests-fixnum-1-minus-f most-negative-fixnum)
+  (should (= (comp-test-apply #'comp-tests-fixnum-1-minus-f 10) 9))
+  (should (= (comp-test-apply #'comp-tests-fixnum-1-minus-f most-negative-fixnum)
              (1- most-negative-fixnum)))
   (should (equal (condition-case err
                      (comp-tests-fixnum-1-minus-f 'a)
                    (error err))
                  '(wrong-type-argument number-or-marker-p a)))
-  (should (= (comp-tests-fixnum-1-plus-f 10) 11))
-  (should (= (comp-tests-fixnum-1-plus-f most-positive-fixnum)
+  (should (= (comp-test-apply #'comp-tests-fixnum-1-plus-f 10) 11))
+  (should (= (comp-test-apply #'comp-tests-fixnum-1-plus-f most-positive-fixnum)
              (1+ most-positive-fixnum)))
   (should (equal (condition-case err
                      (comp-tests-fixnum-1-plus-f 'a)
                    (error err))
                  '(wrong-type-argument number-or-marker-p a)))
-  (should (= (comp-tests-fixnum-minus-f 10) -10))
-  (should (= (comp-tests-fixnum-minus-f most-negative-fixnum)
+  (should (= (comp-test-apply #'comp-tests-fixnum-minus-f 10) -10))
+  (should (= (comp-test-apply #'comp-tests-fixnum-minus-f most-negative-fixnum)
              (- most-negative-fixnum)))
   (should (equal (condition-case err
                      (comp-tests-fixnum-minus-f 'a)
                    (error err))
                  '(wrong-type-argument number-or-marker-p a))))
 
-(ert-deftest  comp-tests-arith-comp ()
+(ert-deftest comp-tests-arith-comp ()
   "Testing arithmetic comparisons."
   (defun comp-tests-eqlsign-f (x y)
     ;; Beqlsign
@@ -291,27 +289,21 @@
     ;; Bgeq
     (>= x y))
 
-  (native-compile #'comp-tests-eqlsign-f)
-  (native-compile #'comp-tests-gtr-f)
-  (native-compile #'comp-tests-lss-f)
-  (native-compile #'comp-tests-les-f)
-  (native-compile #'comp-tests-geq-f)
-
-  (should (eq (comp-tests-eqlsign-f 4 3) nil))
-  (should (eq (comp-tests-eqlsign-f 3 3) t))
-  (should (eq (comp-tests-eqlsign-f 2 3) nil))
-  (should (eq (comp-tests-gtr-f 4 3) t))
-  (should (eq (comp-tests-gtr-f 3 3) nil))
-  (should (eq (comp-tests-gtr-f 2 3) nil))
-  (should (eq (comp-tests-lss-f 4 3) nil))
-  (should (eq (comp-tests-lss-f 3 3) nil))
-  (should (eq (comp-tests-lss-f 2 3) t))
-  (should (eq (comp-tests-les-f 4 3) nil))
-  (should (eq (comp-tests-les-f 3 3) t))
-  (should (eq (comp-tests-les-f 2 3) t))
-  (should (eq (comp-tests-geq-f 4 3) t))
-  (should (eq (comp-tests-geq-f 3 3) t))
-  (should (eq (comp-tests-geq-f 2 3) nil)))
+  (should (eq (comp-test-apply #'comp-tests-eqlsign-f 4 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-eqlsign-f 3 3) t))
+  (should (eq (comp-test-apply #'comp-tests-eqlsign-f 2 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-gtr-f 4 3) t))
+  (should (eq (comp-test-apply #'comp-tests-gtr-f 3 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-gtr-f 2 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-lss-f 4 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-lss-f 3 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-lss-f 2 3) t))
+  (should (eq (comp-test-apply #'comp-tests-les-f 4 3) nil))
+  (should (eq (comp-test-apply #'comp-tests-les-f 3 3) t))
+  (should (eq (comp-test-apply #'comp-tests-les-f 2 3) t))
+  (should (eq (comp-test-apply #'comp-tests-geq-f 4 3) t))
+  (should (eq (comp-test-apply #'comp-tests-geq-f 3 3) t))
+  (should (eq (comp-test-apply #'comp-tests-geq-f 2 3) nil)))
 
 (ert-deftest comp-tests-setcarcdr ()
   "Testing setcar setcdr."
@@ -322,11 +314,8 @@
     (setcdr x y)
     x)
 
-  (native-compile #'comp-tests-setcar-f)
-  (native-compile #'comp-tests-setcdr-f)
-
-  (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10)))
-  (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3)))
+  (should (equal (comp-test-apply #'comp-tests-setcar-f '(10 . 10) 3) '(3 . 10)))
+  (should (equal (comp-test-apply #'comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3)))
   (should (equal (condition-case
                      err
                      (comp-tests-setcar-f 3 10)
@@ -334,7 +323,7 @@
                  '(wrong-type-argument consp 3)))
   (should (equal (condition-case
                      err
-                     (comp-tests-setcdr-f 3 10)
+                     (comp-test-apply #'comp-tests-setcdr-f 3 10)
                    (error err))
                  '(wrong-type-argument consp 3))))
 
@@ -352,14 +341,12 @@
         (setq i (1- i)))
       list))
 
-  (native-compile #'comp-bubble-sort-f)
-
   (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-tests-list-inline ()
+(ert-deftest comp-test-apply ()
   "Test some inlined list functions."
   (defun comp-tests-consp-f (x)
     ;; Bconsp
@@ -368,13 +355,10 @@
     ;; Bsetcar
     (setcar x 3))
 
-  (native-compile #'comp-tests-consp-f)
-  (native-compile #'comp-tests-car-f)
-
-  (should (eq (comp-tests-consp-f '(1)) t))
-  (should (eq (comp-tests-consp-f 1) nil))
+  (should (eq (comp-test-apply #'comp-tests-consp-f '(1)) t))
+  (should (eq (comp-test-apply #'comp-tests-consp-f 1) nil))
   (let ((x (cons 1 2)))
-    (should (= (comp-tests-car-f x) 3))
+    (should (= (comp-test-apply #'comp-tests-car-f x) 3))
     (should (equal x '(3 . 2)))))
 
 (ert-deftest comp-tests-num-inline ()
@@ -386,17 +370,14 @@
     ;; Bnumberp
     (numberp x))
 
-  (native-compile #'comp-tests-integerp-f)
-  (native-compile #'comp-tests-numberp-f)
-
-  (should (eq (comp-tests-integerp-f 1) t))
-  (should (eq (comp-tests-integerp-f '(1)) nil))
-  (should (eq (comp-tests-integerp-f 3.5) nil))
-  (should (eq (comp-tests-integerp-f (1+ most-negative-fixnum)) t))
+  (should (eq (comp-test-apply #'comp-tests-integerp-f 1) t))
+  (should (eq (comp-test-apply #'comp-tests-integerp-f '(1)) nil))
+  (should (eq (comp-test-apply #'comp-tests-integerp-f 3.5) nil))
+  (should (eq (comp-test-apply #'comp-tests-integerp-f (1+ most-negative-fixnum)) t))
 
-  (should (eq (comp-tests-numberp-f 1) t))
-  (should (eq (comp-tests-numberp-f 'a) nil))
-  (should (eq (comp-tests-numberp-f 3.5) t)))
+  (should (eq (comp-test-apply #'comp-tests-numberp-f 1) t))
+  (should (eq (comp-test-apply #'comp-tests-numberp-f 'a) nil))
+  (should (eq (comp-test-apply #'comp-tests-numberp-f 3.5) t)))
 
 (ert-deftest comp-tests-stack ()
   "Test some stack operation."
@@ -410,11 +391,7 @@
     ;; Binsert
     (insert a b c d))
 
-  (native-compile #'comp-tests-discardn-f)
-  (native-compile #'comp-tests-insertn-f)
-
-  (should (= (comp-tests-discardn-f 10) 2))
-
+  (should (= (comp-test-apply #'comp-tests-discardn-f 10) 2))
   (should (string= (with-temp-buffer
                       (comp-tests-insertn-f "a" "b" "c" "d")
                       (buffer-string))
@@ -459,16 +436,13 @@
     (defun comp-tests-throw-f (x)
       (throw 'foo x))
 
-    (native-compile #'comp-tests-condition-case-0-f)
-    (native-compile #'comp-tests-condition-case-1-f)
-    (native-compile #'comp-tests-catch-f)
-    (native-compile #'comp-tests-throw-f)
-
-    (should (string= (comp-tests-condition-case-0-f)
+    (should (string= (comp-test-apply #'comp-tests-condition-case-0-f)
                      "arith-error Arithmetic error catched"))
-    (should (string= (comp-tests-condition-case-1-f)
+    (should (string= (comp-test-apply #'comp-tests-condition-case-1-f)
                      "error foo catched"))
-    (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3))
+    (should (= (comp-test-apply #'comp-tests-catch-f
+                                (lambda () (throw 'foo 3)))
+               3))
     (should (= (catch 'foo
                  (comp-tests-throw-f 3))))))
 
@@ -477,17 +451,12 @@
   (dotimes (_ 100000)
     (comp-tests-cons-cdr-f 3))
 
-  (should (= (comp-tests-cons-cdr-f 3) 3)))
+  (should (= (comp-test-apply #'comp-tests-cons-cdr-f 3) 3)))
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
 ;;;;;;;;;;;;;;;;;;;;
 
-(defun comp-test-apply (func &rest args)
-  (unless (subrp (symbol-function func))
-    (native-compile func))
-  (apply func args))
-
 ;; Test Bconsp.
 (defun comp-test-consp (x) (consp x))