add tromeys tests

1 files changed, 280 insertions, 0 deletions

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 96362ecf6e5..332dd3f8c0f 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -479,4 +479,284 @@
 
   (should (= (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))
+
+(ert-deftest comp-consp ()
+  (should-not (comp-test-apply 'comp-test-consp 23))
+  (should-not (comp-test-apply 'comp-test-consp nil))
+  (should (comp-test-apply 'comp-test-consp '(1 . 2))))
+
+;; Test Blistp.
+(defun comp-test-listp (x) (listp x))
+
+(ert-deftest comp-listp ()
+  (should-not (comp-test-apply 'comp-test-listp 23))
+  (should (comp-test-apply 'comp-test-listp nil))
+  (should (comp-test-apply 'comp-test-listp '(1 . 2))))
+
+;; Test Bstringp.
+(defun comp-test-stringp (x) (stringp x))
+
+(ert-deftest comp-stringp ()
+  (should-not (comp-test-apply 'comp-test-stringp 23))
+  (should-not (comp-test-apply 'comp-test-stringp nil))
+  (should (comp-test-apply 'comp-test-stringp "hi")))
+
+;; Test Bsymbolp.
+(defun comp-test-symbolp (x) (symbolp x))
+
+(ert-deftest comp-symbolp ()
+  (should-not (comp-test-apply 'comp-test-symbolp 23))
+  (should-not (comp-test-apply 'comp-test-symbolp "hi"))
+  (should (comp-test-apply 'comp-test-symbolp 'whatever)))
+
+;; Test Bintegerp.
+(defun comp-test-integerp (x) (integerp x))
+
+(ert-deftest comp-integerp ()
+  (should (comp-test-apply 'comp-test-integerp 23))
+  (should-not (comp-test-apply 'comp-test-integerp 57.5))
+  (should-not (comp-test-apply 'comp-test-integerp "hi"))
+  (should-not (comp-test-apply 'comp-test-integerp 'whatever)))
+
+;; Test Bnumberp.
+(defun comp-test-numberp (x) (numberp x))
+
+(ert-deftest comp-numberp ()
+  (should (comp-test-apply 'comp-test-numberp 23))
+  (should (comp-test-apply 'comp-test-numberp 57.5))
+  (should-not (comp-test-apply 'comp-test-numberp "hi"))
+  (should-not (comp-test-apply 'comp-test-numberp 'whatever)))
+
+;; Test Badd1.
+(defun comp-test-add1 (x) (1+ x))
+
+(ert-deftest comp-add1 ()
+  (should (eq (comp-test-apply 'comp-test-add1 23) 24))
+  (should (eq (comp-test-apply 'comp-test-add1 -17) -16))
+  (should (eql (comp-test-apply 'comp-test-add1 1.0) 2.0))
+  (should-error (comp-test-apply 'comp-test-add1 nil)
+                :type 'wrong-type-argument))
+
+;; Test Bsub1.
+(defun comp-test-sub1 (x) (1- x))
+
+(ert-deftest comp-sub1 ()
+  (should (eq (comp-test-apply 'comp-test-sub1 23) 22))
+  (should (eq (comp-test-apply 'comp-test-sub1 -17) -18))
+  (should (eql (comp-test-apply 'comp-test-sub1 1.0) 0.0))
+  (should-error (comp-test-apply 'comp-test-sub1 nil)
+                :type 'wrong-type-argument))
+
+;; Test Bneg.
+(defun comp-test-negate (x) (- x))
+
+(ert-deftest comp-negate ()
+  (should (eq (comp-test-apply 'comp-test-negate 23) -23))
+  (should (eq (comp-test-apply 'comp-test-negate -17) 17))
+  (should (eql (comp-test-apply 'comp-test-negate 1.0) -1.0))
+  (should-error (comp-test-apply 'comp-test-negate nil)
+                :type 'wrong-type-argument))
+
+;; Test Bnot.
+(defun comp-test-not (x) (not x))
+
+(ert-deftest comp-not ()
+  (should (eq (comp-test-apply 'comp-test-not 23) nil))
+  (should (eq (comp-test-apply 'comp-test-not nil) t))
+  (should (eq (comp-test-apply 'comp-test-not t) nil)))
+
+;; Test Bbobp, Beobp, Bpoint, Bpoint_min, Bpoint_max.
+(defun comp-test-bobp () (bobp))
+(defun comp-test-eobp () (eobp))
+(defun comp-test-point () (point))
+(defun comp-test-point-min () (point-min))
+(defun comp-test-point-max () (point-max))
+
+(ert-deftest comp-bobp-and-eobp ()
+  (with-temp-buffer
+    (should (comp-test-apply 'comp-test-bobp))
+    (should (comp-test-apply 'comp-test-eobp))
+    (insert "hi")
+    (goto-char (point-min))
+    (should (eq (comp-test-apply 'comp-test-point-min) (point-min)))
+    (should (eq (comp-test-apply 'comp-test-point) (point-min)))
+    (should (comp-test-apply 'comp-test-bobp))
+    (should-not (comp-test-apply 'comp-test-eobp))
+    (goto-char (point-max))
+    (should (eq (comp-test-apply 'comp-test-point-max) (point-max)))
+    (should (eq (comp-test-apply 'comp-test-point) (point-max)))
+    (should-not (comp-test-apply 'comp-test-bobp))
+    (should (comp-test-apply 'comp-test-eobp))))
+
+;; Test Bcar and Bcdr.
+(defun comp-test-car (x) (car x))
+(defun comp-test-cdr (x) (cdr x))
+
+(ert-deftest comp-car-cdr ()
+  (let ((pair '(1 . b)))
+    (should (eq (comp-test-apply 'comp-test-car pair) 1))
+    (should (eq (comp-test-apply 'comp-test-car nil) nil))
+    (should-error (comp-test-apply 'comp-test-car 23)
+                  :type 'wrong-type-argument)
+    (should (eq (comp-test-apply 'comp-test-cdr pair) 'b))
+    (should (eq (comp-test-apply 'comp-test-cdr nil) nil))
+    (should-error (comp-test-apply 'comp-test-cdr 23)
+                  :type 'wrong-type-argument)))
+
+;; Test Bcar_safe and Bcdr_safe.
+(defun comp-test-car-safe (x) (car-safe x))
+(defun comp-test-cdr-safe (x) (cdr-safe x))
+
+(ert-deftest comp-car-cdr-safe ()
+  (let ((pair '(1 . b)))
+    (should (eq (comp-test-apply 'comp-test-car-safe pair) 1))
+    (should (eq (comp-test-apply 'comp-test-car-safe nil) nil))
+    (should (eq (comp-test-apply 'comp-test-car-safe 23) nil))
+    (should (eq (comp-test-apply 'comp-test-cdr-safe pair) 'b))
+    (should (eq (comp-test-apply 'comp-test-cdr-safe nil) nil))
+    (should (eq (comp-test-apply 'comp-test-cdr-safe 23) nil))))
+
+;; Test Beq.
+(defun comp-test-eq (x y) (eq x y))
+
+(ert-deftest comp-eq ()
+  (should (comp-test-apply 'comp-test-eq 'a 'a))
+  (should (comp-test-apply 'comp-test-eq 5 5))
+  (should-not (comp-test-apply 'comp-test-eq 'a 'b))
+  (should-not (comp-test-apply 'comp-test-eq "x" "x")))
+
+;; Test Bgotoifnil.
+(defun comp-test-if (x y) (if x x y))
+
+(ert-deftest comp-if ()
+  (should (eq (comp-test-apply 'comp-test-if 'a 'b) 'a))
+  (should (eq (comp-test-apply 'comp-test-if 0 23) 0))
+  (should (eq (comp-test-apply 'comp-test-if nil 'b) 'b)))
+
+;; Test Bgotoifnilelsepop.
+(defun comp-test-and (x y) (and x y))
+
+(ert-deftest comp-and ()
+  (should (eq (comp-test-apply 'comp-test-and 'a 'b) 'b))
+  (should (eq (comp-test-apply 'comp-test-and 0 23) 23))
+  (should (eq (comp-test-apply 'comp-test-and nil 'b) nil)))
+
+;; Test Bgotoifnonnilelsepop.
+(defun comp-test-or (x y) (or x y))
+
+(ert-deftest comp-or ()
+  (should (eq (comp-test-apply 'comp-test-or 'a 'b) 'a))
+  (should (eq (comp-test-apply 'comp-test-or 0 23) 0))
+  (should (eq (comp-test-apply 'comp-test-or nil 'b) 'b)))
+
+;; Test Bsave_excursion.
+(defun comp-test-save-excursion ()
+  (save-excursion
+    (insert "XYZ")))
+
+;; Test Bcurrent_buffer.
+(defun comp-test-current-buffer () (current-buffer))
+
+(ert-deftest comp-save-excursion ()
+  (with-temp-buffer
+    (comp-test-apply 'comp-test-save-excursion)
+    (should (eq (point) (point-min)))
+    (should (eq (comp-test-apply 'comp-test-current-buffer) (current-buffer)))))
+
+;; Test Bgtr.
+(defun comp-test-> (a b)
+  (> a b))
+
+(ert-deftest comp-> ()
+  (should (eq (comp-test-apply 'comp-test-> 0 23) nil))
+  (should (eq (comp-test-apply 'comp-test-> 23 0) t)))
+
+;; Test Bpushcatch.
+(defun comp-test-catch (&rest l)
+  (catch 'done
+    (dolist (v l)
+      (when (> v 23)
+        (throw 'done v)))))
+
+(ert-deftest comp-catch ()
+  (should (eq (comp-test-apply 'comp-test-catch 0 1 2 3 4) nil))
+  (should (eq (comp-test-apply 'comp-test-catch 20 21 22 23 24 25 26 27 28) 24)))
+
+;; Test Bmemq.
+(defun comp-test-memq (val list)
+  (memq val list))
+
+(ert-deftest comp-memq ()
+  (should (equal (comp-test-apply 'comp-test-memq 0 '(5 4 3 2 1 0)) '(0)))
+  (should (eq (comp-test-apply 'comp-test-memq 72 '(5 4 3 2 1 0)) nil)))
+
+;; Test BlistN.
+(defun comp-test-listN (x)
+  (list x x x x x x x x x x x x x x x x))
+
+(ert-deftest comp-listN ()
+  (should (equal (comp-test-apply 'comp-test-listN 57)
+                 '(57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57))))
+
+;; Test BconcatN.
+(defun comp-test-concatN (x)
+  (concat x x x x x x))
+
+(ert-deftest comp-concatN ()
+  (should (equal (comp-test-apply 'comp-test-concatN "x") "xxxxxx")))
+
+;; Test optional and rest arguments.
+(defun comp-test-opt-rest (a &optional b &rest c)
+  (list a b c))
+
+(ert-deftest comp-opt-rest ()
+  (should (equal (comp-test-apply 'comp-test-opt-rest 1) '(1 nil nil)))
+  (should (equal (comp-test-apply 'comp-test-opt-rest 1 2) '(1 2 nil)))
+  (should (equal (comp-test-apply 'comp-test-opt-rest 1 2 3) '(1 2 (3))))
+  (should (equal (comp-test-apply 'comp-test-opt-rest 1 2 56 57 58)
+                 '(1 2 (56 57 58)))))
+
+;; Test for too many arguments.
+(defun comp-test-opt (a &optional b)
+  (cons a b))
+
+(ert-deftest comp-opt ()
+  (should (equal (comp-test-apply 'comp-test-opt 23) '(23)))
+  (should (equal (comp-test-apply 'comp-test-opt 23 24) '(23 . 24)))
+  (should-error (comp-test-apply 'comp-test-opt)
+                :type 'wrong-number-of-arguments)
+  (should-error (comp-test-apply 'comp-test-opt nil 24 97)
+                :type 'wrong-number-of-arguments))
+
+;; Test for unwind-protect.
+(defvar comp-test-up-val nil)
+(defun comp-test-unwind-protect (fun)
+  (setq comp-test-up-val nil)
+  (unwind-protect
+      (progn
+        (setq comp-test-up-val 23)
+        (funcall fun)
+        (setq comp-test-up-val 24))
+    (setq comp-test-up-val 999)))
+
+(ert-deftest comp-unwind-protect ()
+  (comp-test-unwind-protect 'ignore)
+  (should (eq comp-test-up-val 999))
+  (condition-case nil
+      (comp-test-unwind-protect (lambda () (error "HI")))
+    (error
+     nil))
+  (should (eq comp-test-up-val 999)))
+
 ;;; comp-tests.el ends here