\f
/* Arithmetic functions */
-enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
-
-static Lisp_Object
-arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
+Lisp_Object
+arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison)
{
double f1 = 0, f2 = 0;
bool floatp = 0;
switch (comparison)
{
- case equal:
+ case ARITH_EQUAL:
if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
return Qt;
return Qnil;
- case notequal:
+ case ARITH_NOTEQUAL:
if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
return Qt;
return Qnil;
- case less:
+ case ARITH_LESS:
if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
return Qt;
return Qnil;
- case less_or_equal:
+ case ARITH_LESS_OR_EQUAL:
if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
return Qt;
return Qnil;
- case grtr:
+ case ARITH_GRTR:
if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
return Qt;
return Qnil;
- case grtr_or_equal:
+ case ARITH_GRTR_OR_EQUAL:
if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
return Qt;
return Qnil;
}
}
-DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
- doc: /* Return t if two args, both numbers or markers, are equal. */)
- (register Lisp_Object num1, Lisp_Object num2)
+static Lisp_Object
+arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
+ enum Arith_Comparison comparison)
{
- return arithcompare (num1, num2, equal);
+ for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
+ {
+ if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
+ return Qnil;
+ }
+ return Qt;
}
-DEFUN ("<", Flss, Slss, 2, 2, 0,
- doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */)
- (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0,
+ doc: /* Return t if args, all numbers or markers, are equal. */)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- return arithcompare (num1, num2, less);
+ return arithcompare_driver (nargs, args, ARITH_EQUAL);
}
-DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
- doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */)
- (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<", Flss, Slss, 1, MANY, 0,
+ doc: /* Return t if each arg is less than the next arg. All must be numbers or markers. */)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- return arithcompare (num1, num2, grtr);
+ return arithcompare_driver (nargs, args, ARITH_LESS);
}
-DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
- doc: /* Return t if first arg is less than or equal to second arg.
-Both must be numbers or markers. */)
- (register Lisp_Object num1, Lisp_Object num2)
+DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
+ doc: /* Return t if each arg is greater than the next arg. All must be numbers or markers. */)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- return arithcompare (num1, num2, less_or_equal);
+ return arithcompare_driver (nargs, args, ARITH_GRTR);
}
-DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
- doc: /* Return t if first arg is greater than or equal to second arg.
-Both must be numbers or markers. */)
- (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
+ doc: /* Return t if each arg is less than or equal to the next arg.
+All must be numbers or markers. */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL);
+}
+
+DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
+ doc: /* Return t if each arg is greater than or equal to the next arg.
+All must be numbers or markers. */)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- return arithcompare (num1, num2, grtr_or_equal);
+ return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
}
DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */)
(register Lisp_Object num1, Lisp_Object num2)
{
- return arithcompare (num1, num2, notequal);
+ return arithcompare (num1, num2, ARITH_NOTEQUAL);
}
DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
--- /dev/null
+;;; data-tests.el --- tests for src/data.c
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest data-tests-= ()
+ (should-error (=))
+ (should (= 1))
+ (should (= 2 2))
+ (should (= 9 9 9 9 9 9 9 9 9))
+ (should-not (apply #'= '(3 8 3)))
+ (should-error (= 9 9 'foo))
+ ;; Short circuits before getting to bad arg
+ (should-not (= 9 8 'foo)))
+
+(ert-deftest data-tests-< ()
+ (should-error (<))
+ (should (< 1))
+ (should (< 2 3))
+ (should (< -6 -1 0 2 3 4 8 9 999))
+ (should-not (apply #'< '(3 8 3)))
+ (should-error (< 9 10 'foo))
+ ;; Short circuits before getting to bad arg
+ (should-not (< 9 8 'foo)))
+
+(ert-deftest data-tests-> ()
+ (should-error (>))
+ (should (> 1))
+ (should (> 3 2))
+ (should (> 6 1 0 -2 -3 -4 -8 -9 -999))
+ (should-not (apply #'> '(3 8 3)))
+ (should-error (> 9 8 'foo))
+ ;; Short circuits before getting to bad arg
+ (should-not (> 8 9 'foo)))
+
+(ert-deftest data-tests-<= ()
+ (should-error (<=))
+ (should (<= 1))
+ (should (<= 2 3))
+ (should (<= -6 -1 -1 0 0 0 2 3 4 8 999))
+ (should-not (apply #'<= '(3 8 3 3)))
+ (should-error (<= 9 10 'foo))
+ ;; Short circuits before getting to bad arg
+ (should-not (<= 9 8 'foo)))
+
+(ert-deftest data-tests->= ()
+ (should-error (>=))
+ (should (>= 1))
+ (should (>= 3 2))
+ (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))
+ (should-not (apply #'>= '(3 8 3)))
+ (should-error (>= 9 8 'foo))
+ ;; Short circuits before getting to bad arg
+ (should-not (>= 8 9 'foo)))
+
+;;; data-tests.el ends here
+
projects / emacs.git / commitdiff