(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
projects / emacs.git / commitdiff