Move timestamp-related stuff to timefns.c

This does not change behavior; it’s just long-overdue
refactoring (Bug#32902).
* src/emacs.c (main): Call init_timefns, syms_of_timefns.
* src/timefns.c: New file, containing timestamp-related stuff
from editfns.c and sysdep.c.
* src/Makefile.in (base_obj): Add timefns.o.
* src/editfns.c: Simplify by moving a big chunk to timefns.c.
Do not include systime.h, sys/resource.h, sys/param.h,
strftime.h, coding.h.
(HAVE_TZALLOC_BUG, TM_YEAR_BASE, HAVE_TM_GMTOFF, tzeqlen)
(local_tz, utc_tz, emacs_localtime_rz, emacs_mktime_z)
(invalid_time_zone_specification, xtzfree, tzlookup)
(TIME_T_MIN, TIME_T_MAX, time_overflow, invalid_time)
(check_time_validity, hi_time, lo_time, Fcurrent_time)
(time_add, time_subtract, time_arith, Ftime_add)
(Ftime_subtract, Ftime_less_p, Fget_internal_run_time)
(make_lisp_time, disassemble_lisp_time, decode_float_time)
(lisp_to_timespec, lisp_time_struct, lisp_time_argument)
(lisp_seconds_argument, Ffloat_time, emacs_nmemftime)
(Fformat_time_string, format_time_string, Fdecode_time)
(check_tm_member, Fencode_time, Fcurrent_time_string)
(tm_gmtoff, Fcurrent_time_zone, Fset_time_zone_rule)
(emacs_getenv_TZ, emacs_setenv_TZ): Move to timefns.c.
* src/emacs.c (main): Adjust to initialization changes.
* src/sysdep.c: Include <sys/resource.h> if it's present.
Regularize includes a bit.
(Fget_internal_run_time): Move here from editfns.c.
(init_timefns, syms_of_timefns): New functions.
* src/w32.h (w32_get_internal_run_time): Move decl here
so that it need not be cloned.
* test/src/editfns-tests.el:
* test/src/editfns-tests.el (format-time-string-with-zone)
(format-time-string-with-outlandish-zone)
(editfns-tests--have-leap-seconds)
(format-time-string-with-bignum-on-32-bit):
Move to ...
* test/src/timefns-tests.el: ... this new file.
This commit is contained in:
Paul Eggert 2018-10-03 09:10:00 -07:00
parent 44bf4a6b01
commit b5d08da1e9
11 changed files with 1440 additions and 1388 deletions

View file

@ -399,7 +399,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
syntax.o $(UNEXEC_OBJ) bytecode.o \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \

File diff suppressed because it is too large Load diff

View file

@ -1512,6 +1512,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_minibuf ();
syms_of_process ();
syms_of_search ();
syms_of_sysdep ();
syms_of_timefns ();
syms_of_frame ();
syms_of_syntax ();
syms_of_terminal ();
@ -1653,9 +1655,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_charset ();
/* This calls putenv and so must precede init_process_emacs. Also,
it sets Voperating_system_release, which init_process_emacs uses. */
init_editfns (dumping);
/* This calls putenv and so must precede init_process_emacs. */
init_timefns (dumping);
/* This sets Voperating_system_release, which init_process_emacs uses. */
init_editfns ();
/* These two call putenv. */
#ifdef HAVE_DBUS

View file

@ -4014,11 +4014,10 @@ extern void save_excursion_save (union specbinding *);
extern void save_excursion_restore (Lisp_Object, Lisp_Object);
extern Lisp_Object save_restriction_save (void);
extern void save_restriction_restore (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
extern void init_editfns (bool);
extern void init_editfns (void);
extern void syms_of_editfns (void);
/* Defined in buffer.c. */
@ -4355,6 +4354,7 @@ extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
extern int renameat_noreplace (int, char const *, int, char const *);
extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern void syms_of_sysdep (void);
/* Defined in filelock.c. */
extern void lock_file (Lisp_Object);

View file

@ -91,13 +91,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <sys/file.h>
#include <fcntl.h>
#include "syssignal.h"
#include "systime.h"
#include "systty.h"
#include "syswait.h"
#ifdef HAVE_SYS_RESOURCE_H
# include <sys/resource.h>
#endif
#ifdef HAVE_SYS_UTSNAME_H
#include <sys/utsname.h>
#include <memory.h>
#endif /* HAVE_SYS_UTSNAME_H */
# include <sys/utsname.h>
# include <memory.h>
#endif
#include "keyboard.h"
#include "frame.h"
@ -118,18 +124,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#endif
#ifdef WINDOWSNT
#include <direct.h>
# include <direct.h>
/* In process.h which conflicts with the local copy. */
#define _P_WAIT 0
# define _P_WAIT 0
int _cdecl _spawnlp (int, const char *, const char *, ...);
/* The following is needed for O_CLOEXEC, F_SETFD, FD_CLOEXEC, and
several prototypes of functions called below. */
#include <sys/socket.h>
# include <sys/socket.h>
#endif
#include "syssignal.h"
#include "systime.h"
/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */
#ifndef ULLONG_MAX
#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int)
@ -2704,30 +2707,6 @@ emacs_perror (char const *message)
errno = err;
}
/* Return a struct timeval that is roughly equivalent to T.
Use the least timeval not less than T.
Return an extremal value if the result would overflow. */
struct timeval
make_timeval (struct timespec t)
{
struct timeval tv;
tv.tv_sec = t.tv_sec;
tv.tv_usec = t.tv_nsec / 1000;
if (t.tv_nsec % 1000 != 0)
{
if (tv.tv_usec < 999999)
tv.tv_usec++;
else if (tv.tv_sec < TYPE_MAXIMUM (time_t))
{
tv.tv_sec++;
tv.tv_usec = 0;
}
}
return tv;
}
/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
ATIME and MTIME, respectively.
FD must be either negative -- in which case it is ignored --
@ -3911,6 +3890,42 @@ system_process_attributes (Lisp_Object pid)
}
#endif /* !defined (WINDOWSNT) */
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0,
doc: /* Return the current run time used by Emacs.
The time is returned as in the style of `current-time'.
On systems that can't determine the run time, `get-internal-run-time'
does the same thing as `current-time'. */)
(void)
{
#ifdef HAVE_GETRUSAGE
struct rusage usage;
time_t secs;
int usecs;
if (getrusage (RUSAGE_SELF, &usage) < 0)
/* This shouldn't happen. What action is appropriate? */
xsignal0 (Qerror);
/* Sum up user time and system time. */
secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
if (usecs >= 1000000)
{
usecs -= 1000000;
secs++;
}
return make_lisp_time (make_timespec (secs, usecs * 1000));
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
return w32_get_internal_run_time ();
#else /* ! WINDOWSNT */
return Fcurrent_time ();
#endif /* WINDOWSNT */
#endif /* HAVE_GETRUSAGE */
}
/* Wide character string collation. */
@ -4116,3 +4131,9 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
return res;
}
#endif /* WINDOWSNT */
void
syms_of_sysdep (void)
{
defsubr (&Sget_internal_run_time);
}

View file

@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSTIME_H
#define EMACS_SYSTIME_H
#include "lisp.h"
#include <timespec.h>
INLINE_HEADER_BEGIN
@ -66,7 +67,6 @@ timespec_valid_p (struct timespec t)
/* defined in sysdep.c */
extern int set_file_times (int, const char *, struct timespec, struct timespec);
extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST;
/* defined in keyboard.c */
extern void set_waiting_for_input (struct timespec *);
@ -82,12 +82,16 @@ struct lisp_time
int lo, us, ps;
};
/* defined in editfns.c */
/* defined in timefns.c */
extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST;
extern Lisp_Object make_lisp_time (struct timespec);
extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, struct lisp_time *, double *);
extern struct timespec lisp_to_timespec (struct lisp_time);
extern struct timespec lisp_time_argument (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern void init_timefns (bool);
extern void syms_of_timefns (void);
INLINE_HEADER_END

1287
src/timefns.c Normal file

File diff suppressed because it is too large Load diff

View file

@ -535,8 +535,6 @@ static Lisp_Object ltime (ULONGLONG);
/* Get total user and system times for get-internal-run-time.
Returns a list of integers if the times are provided by the OS
(NT derivatives), otherwise it returns the result of current-time. */
Lisp_Object w32_get_internal_run_time (void);
Lisp_Object
w32_get_internal_run_time (void)
{

View file

@ -195,6 +195,7 @@ extern int filename_from_ansi (const char *, char *);
extern int filename_to_ansi (const char *, char *);
extern int filename_from_utf16 (const wchar_t *, char *);
extern int filename_to_utf16 (const char *, wchar_t *);
extern Lisp_Object w32_get_internal_run_time (void);
extern void w32_init_file_name_codepage (void);
extern int codepage_for_filenames (CPINFO *);
extern Lisp_Object ansi_encode_filename (Lisp_Object);

View file

@ -204,65 +204,6 @@
(should (string-equal (format "%d" 0.9) "0"))
(should (string-equal (format "%d" 1.1) "1")))
;;; Check format-time-string with various TZ settings.
;;; Use only POSIX-compatible TZ values, since the tests should work
;;; even if tzdb is not in use.
(ert-deftest format-time-string-with-zone ()
;; Dont use (0 0 0 0) as the test case, as there are too many bugs
;; in MS-Windows (and presumably other) C libraries when formatting
;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
;; test is for GNU Emacs, not for C runtimes. Instead, look before
;; you leap: "look" is the timestamp just before the first leap
;; second on 1972-06-30 23:59:60 UTC, so it should format to the
;; same string regardless of whether the underlying C library
;; ignores leap seconds, while avoiding circa-1970 glitches.
;;
;; Similarly, stick to the limited set of time zones that are
;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
;; in the abbreviation, and no DST.
(let ((look '(1202 22527 999999 999999))
(format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
;; UTC.
(should (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
"1972-06-30 23:59:59.999 +0000"))
;; "UTC0".
(should (string-equal
(format-time-string format look "UTC0")
"1972-06-30 23:59:59.999 +0000 (UTC)"))
;; Negative UTC offset, as a Lisp list.
(should (string-equal
(format-time-string format look '(-28800 "PST"))
"1972-06-30 15:59:59.999 -0800 (PST)"))
;; Negative UTC offset, as a Lisp integer.
(should (string-equal
(format-time-string format look -28800)
;; MS-Windows build replaces unrecognizable TZ values,
;; such as "-08", with "ZZZ".
(if (eq system-type 'windows-nt)
"1972-06-30 15:59:59.999 -0800 (ZZZ)"
"1972-06-30 15:59:59.999 -0800 (-08)")))
;; Positive UTC offset that is not an hour multiple, as a string.
(should (string-equal
(format-time-string format look "IST-5:30")
"1972-07-01 05:29:59.999 +0530 (IST)"))))
;;; This should not dump core.
(ert-deftest format-time-string-with-outlandish-zone ()
(should (stringp
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
(concat (make-string 2048 ?X) "0")))))
(defun editfns-tests--have-leap-seconds ()
(string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t)
"1972-06-30 23:59:60"))
(ert-deftest format-time-string-with-bignum-on-32-bit ()
(should (or (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t)
"2038-01-19 02:14:08")
(editfns-tests--have-leap-seconds))))
(ert-deftest format-with-field ()
(should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3)
"First argument 2, then 3, then 1"))

79
test/src/timefns-tests.el Normal file
View file

@ -0,0 +1,79 @@
;;; timefns-tests.el -- tests for timefns.c
;; Copyright (C) 2016-2018 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 <https://www.gnu.org/licenses/>.
(require 'ert)
;;; Check format-time-string with various TZ settings.
;;; Use only POSIX-compatible TZ values, since the tests should work
;;; even if tzdb is not in use.
(ert-deftest format-time-string-with-zone ()
;; Dont use (0 0 0 0) as the test case, as there are too many bugs
;; in MS-Windows (and presumably other) C libraries when formatting
;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
;; test is for GNU Emacs, not for C runtimes. Instead, look before
;; you leap: "look" is the timestamp just before the first leap
;; second on 1972-06-30 23:59:60 UTC, so it should format to the
;; same string regardless of whether the underlying C library
;; ignores leap seconds, while avoiding circa-1970 glitches.
;;
;; Similarly, stick to the limited set of time zones that are
;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
;; in the abbreviation, and no DST.
(let ((look '(1202 22527 999999 999999))
(format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
;; UTC.
(should (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
"1972-06-30 23:59:59.999 +0000"))
;; "UTC0".
(should (string-equal
(format-time-string format look "UTC0")
"1972-06-30 23:59:59.999 +0000 (UTC)"))
;; Negative UTC offset, as a Lisp list.
(should (string-equal
(format-time-string format look '(-28800 "PST"))
"1972-06-30 15:59:59.999 -0800 (PST)"))
;; Negative UTC offset, as a Lisp integer.
(should (string-equal
(format-time-string format look -28800)
;; MS-Windows build replaces unrecognizable TZ values,
;; such as "-08", with "ZZZ".
(if (eq system-type 'windows-nt)
"1972-06-30 15:59:59.999 -0800 (ZZZ)"
"1972-06-30 15:59:59.999 -0800 (-08)")))
;; Positive UTC offset that is not an hour multiple, as a string.
(should (string-equal
(format-time-string format look "IST-5:30")
"1972-07-01 05:29:59.999 +0530 (IST)"))))
;;; This should not dump core.
(ert-deftest format-time-string-with-outlandish-zone ()
(should (stringp
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
(concat (make-string 2048 ?X) "0")))))
(defun timefns-tests--have-leap-seconds ()
(string-equal (format-time-string "%Y-%m-%d %H:%M:%S" 78796800 t)
"1972-06-30 23:59:60"))
(ert-deftest format-time-string-with-bignum-on-32-bit ()
(should (or (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S" (- (ash 1 31) 3600) t)
"2038-01-19 02:14:08")
(timefns-tests--have-leap-seconds))))