aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2018-09-27 18:28:27 -0700
committerPaul Eggert2018-09-27 18:43:54 -0700
commit06e2814e1f3a80d247675319d3c438989592fb06 (patch)
treea9852c5b278bcb85c4f3e0272848f89c2c511d11
parent21fc3227634c720128206980c72080dfc825a3de (diff)
downloademacs-06e2814e1f3a80d247675319d3c438989592fb06.tar.gz
emacs-06e2814e1f3a80d247675319d3c438989592fb06.zip
time-equal, and time values of infinity and NaN
* doc/lispref/os.texi (Time Calculations): Document time-equal, and the behavior on NaNs and infinities of time-less-p, time-add, time-subtract. * etc/NEWS: Mention the change. * src/editfns.c (time_arith): Change last arg from function to bool. All callers changed. Do the right thing with infinities and NaNs. (time_cmp): New function, which handlesx infinities and NaNs. (Ftime_less_p): Use it. (Ftime_equal): New function. * test/lisp/emacs-lisp/timer-tests.el (timer-test-multiple-of-time): Use it.
-rw-r--r--doc/lispref/os.texi11
-rw-r--r--etc/NEWS8
-rw-r--r--src/editfns.c58
-rw-r--r--test/lisp/emacs-lisp/timer-tests.el8
4 files changed, 66 insertions, 19 deletions
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 8481fea8062..67b78aea747 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1736,17 +1736,26 @@ integer number stands for the number of seconds since the epoch.
1736@defun time-less-p t1 t2 1736@defun time-less-p t1 t2
1737This returns @code{t} if time value @var{t1} is less than time value 1737This returns @code{t} if time value @var{t1} is less than time value
1738@var{t2}. 1738@var{t2}.
1739The result is @code{nil} if either argument is a NaN.
1740@end defun
1741
1742@defun time-equal t1 t2
1743This returns @code{t} if @var{t1} and @var{t2} are equal time values.
1744The result is @code{nil} if either argument is a NaN.
1739@end defun 1745@end defun
1740 1746
1741@defun time-subtract t1 t2 1747@defun time-subtract t1 t2
1742This returns the time difference @var{t1} @minus{} @var{t2} between 1748This returns the time difference @var{t1} @minus{} @var{t2} between
1743two time values, as a time value. If you need the difference in units 1749two time values, as a time value. However, the result is a float
1750if either argument is a float infinity or NaN@.
1751If you need the difference in units
1744of elapsed seconds, use @code{float-time} (@pxref{Time of Day, 1752of elapsed seconds, use @code{float-time} (@pxref{Time of Day,
1745float-time}) to convert the result into seconds. 1753float-time}) to convert the result into seconds.
1746@end defun 1754@end defun
1747 1755
1748@defun time-add t1 t2 1756@defun time-add t1 t2
1749This returns the sum of two time values, as a time value. 1757This returns the sum of two time values, as a time value.
1758However, the result is a float if either argument is a float infinity or NaN@.
1750One argument should represent a time difference rather than a point in time, 1759One argument should represent a time difference rather than a point in time,
1751either as a list or as a single number of elapsed seconds. 1760either as a list or as a single number of elapsed seconds.
1752Here is how to add a number of seconds to a time value: 1761Here is how to add a number of seconds to a time value:
diff --git a/etc/NEWS b/etc/NEWS
index 2a609e40278..4dd4260b29e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -951,6 +951,14 @@ like file-attributes that compute file sizes and other attributes,
951functions like process-id that compute process IDs, and functions like 951functions like process-id that compute process IDs, and functions like
952user-uid and group-gid that compute user and group IDs. 952user-uid and group-gid that compute user and group IDs.
953 953
954+++
955** 'time-add', 'time-subtract', and 'time-less-p' now accept
956infinities and NaNs too, and propagate them or return nil like
957floating-point operators do.
958
959+++
960** New function 'time-equal' compares time values for equality.
961
954** define-minor-mode automatically documents the meaning of ARG. 962** define-minor-mode automatically documents the meaning of ARG.
955 963
956+++ 964+++
diff --git a/src/editfns.c b/src/editfns.c
index ec6e8ba98d6..acd80bbf311 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1589,13 +1589,21 @@ time_subtract (struct lisp_time ta, struct lisp_time tb)
1589} 1589}
1590 1590
1591static Lisp_Object 1591static Lisp_Object
1592time_arith (Lisp_Object a, Lisp_Object b, 1592time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1593 struct lisp_time (*op) (struct lisp_time, struct lisp_time))
1594{ 1593{
1594 if (FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
1595 {
1596 double da = XFLOAT_DATA (a);
1597 double db = XFLOAT_DATA (Ffloat_time (b));
1598 return make_float (subtract ? da - db : da + db);
1599 }
1600 if (FLOATP (b) && !isfinite (XFLOAT_DATA (b)))
1601 return subtract ? make_float (-XFLOAT_DATA (b)) : b;
1602
1595 int alen, blen; 1603 int alen, blen;
1596 struct lisp_time ta = lisp_time_struct (a, &alen); 1604 struct lisp_time ta = lisp_time_struct (a, &alen);
1597 struct lisp_time tb = lisp_time_struct (b, &blen); 1605 struct lisp_time tb = lisp_time_struct (b, &blen);
1598 struct lisp_time t = op (ta, tb); 1606 struct lisp_time t = (subtract ? time_subtract : time_add) (ta, tb);
1599 if (FIXNUM_OVERFLOW_P (t.hi)) 1607 if (FIXNUM_OVERFLOW_P (t.hi))
1600 time_overflow (); 1608 time_overflow ();
1601 Lisp_Object val = Qnil; 1609 Lisp_Object val = Qnil;
@@ -1623,7 +1631,7 @@ A nil value for either argument stands for the current time.
1623See `current-time-string' for the various forms of a time value. */) 1631See `current-time-string' for the various forms of a time value. */)
1624 (Lisp_Object a, Lisp_Object b) 1632 (Lisp_Object a, Lisp_Object b)
1625{ 1633{
1626 return time_arith (a, b, time_add); 1634 return time_arith (a, b, false);
1627} 1635}
1628 1636
1629DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0, 1637DEFUN ("time-subtract", Ftime_subtract, Stime_subtract, 2, 2, 0,
@@ -1633,7 +1641,30 @@ A nil value for either argument stands for the current time.
1633See `current-time-string' for the various forms of a time value. */) 1641See `current-time-string' for the various forms of a time value. */)
1634 (Lisp_Object a, Lisp_Object b) 1642 (Lisp_Object a, Lisp_Object b)
1635{ 1643{
1636 return time_arith (a, b, time_subtract); 1644 return time_arith (a, b, true);
1645}
1646
1647/* Return negative, 0, positive if a < b, a == b, a > b respectively.
1648 Return positive if either a or b is a NaN; this is good enough
1649 for the current callers. */
1650static int
1651time_cmp (Lisp_Object a, Lisp_Object b)
1652{
1653 if ((FLOATP (a) && !isfinite (XFLOAT_DATA (a)))
1654 || (FLOATP (b) && !isfinite (XFLOAT_DATA (b))))
1655 {
1656 double da = FLOATP (a) ? XFLOAT_DATA (a) : 0;
1657 double db = FLOATP (b) ? XFLOAT_DATA (b) : 0;
1658 return da < db ? -1 : da != db;
1659 }
1660
1661 int alen, blen;
1662 struct lisp_time ta = lisp_time_struct (a, &alen);
1663 struct lisp_time tb = lisp_time_struct (b, &blen);
1664 return (ta.hi != tb.hi ? (ta.hi < tb.hi ? -1 : 1)
1665 : ta.lo != tb.lo ? (ta.lo < tb.lo ? -1 : 1)
1666 : ta.us != tb.us ? (ta.us < tb.us ? -1 : 1)
1667 : ta.ps < tb.ps ? -1 : ta.ps != tb.ps);
1637} 1668}
1638 1669
1639DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0, 1670DEFUN ("time-less-p", Ftime_less_p, Stime_less_p, 2, 2, 0,
@@ -1642,14 +1673,14 @@ A nil value for either argument stands for the current time.
1642See `current-time-string' for the various forms of a time value. */) 1673See `current-time-string' for the various forms of a time value. */)
1643 (Lisp_Object t1, Lisp_Object t2) 1674 (Lisp_Object t1, Lisp_Object t2)
1644{ 1675{
1645 int t1len, t2len; 1676 return time_cmp (t1, t2) < 0 ? Qt : Qnil;
1646 struct lisp_time a = lisp_time_struct (t1, &t1len); 1677}
1647 struct lisp_time b = lisp_time_struct (t2, &t2len); 1678
1648 return ((a.hi != b.hi ? a.hi < b.hi 1679DEFUN ("time-equal", Ftime_equal, Stime_equal, 2, 2, 0,
1649 : a.lo != b.lo ? a.lo < b.lo 1680 doc: /* Return non-nil if T1 and T2 are equal time values. */)
1650 : a.us != b.us ? a.us < b.us 1681 (Lisp_Object t1, Lisp_Object t2)
1651 : a.ps < b.ps) 1682{
1652 ? Qt : Qnil); 1683 return time_cmp (t1, t2) == 0 ? Qt : Qnil;
1653} 1684}
1654 1685
1655 1686
@@ -5734,6 +5765,7 @@ it to be non-nil. */);
5734 defsubr (&Scurrent_time); 5765 defsubr (&Scurrent_time);
5735 defsubr (&Stime_add); 5766 defsubr (&Stime_add);
5736 defsubr (&Stime_subtract); 5767 defsubr (&Stime_subtract);
5768 defsubr (&Stime_equal);
5737 defsubr (&Stime_less_p); 5769 defsubr (&Stime_less_p);
5738 defsubr (&Sget_internal_run_time); 5770 defsubr (&Sget_internal_run_time);
5739 defsubr (&Sformat_time_string); 5771 defsubr (&Sformat_time_string);
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
index 1d3ba757f63..0e40cdf442f 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -40,10 +40,8 @@
40 (should (debug-timer-check)) t)) 40 (should (debug-timer-check)) t))
41 41
42(ert-deftest timer-test-multiple-of-time () 42(ert-deftest timer-test-multiple-of-time ()
43 (should (zerop 43 (should (time-equal
44 (float-time 44 (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53)))
45 (time-subtract 45 (list (ash 1 (- 53 16)) 1))))
46 (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53)))
47 (list (ash 1 (- 53 16)) 1))))))
48 46
49;;; timer-tests.el ends here 47;;; timer-tests.el ends here