bug#44674: 28.0.50; Adding current-cpu-time for performance tests

[Stefan Monnier]

Package: Emacs
Version: 28.0.50


I tried to write a test for the performance problem seen in bug#41029,
but found it very difficult to make it work half-reliably because we
only have access to wall-clock time from Elisp.

So I suggest we add a new primitive `current-cpu-time` with which those
tests seem to be at least somewhat doable.

See my current patch below which includes a test for that
performance bug.  It clearly requires adding w32 support (or
fetching more clock functionality from gnulib) but I don't know how to
do that.


        Stefan


diff --git a/etc/NEWS b/etc/NEWS
index f21c4cb02c..703fbf5243 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1733,6 +1733,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
 
 * Lisp Changes in Emacs 28.1
 
+---
+** New function 'current-cpu-time'.
+It gives access to the CPU time used by the Emacs process, for
+example for benchmarking purposes.
+
 +++
 ** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
 This can be used to control which major modes the minor mode should be
diff --git a/src/timefns.c b/src/timefns.c
index 4a28f707a3..b569c6d075 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -1793,6 +1793,18 @@ DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 
0, 0,
   return make_lisp_time (current_timespec ());
 }
 
+#ifdef CLOCKS_PER_SEC
+DEFUN ("current-cpu-time", Fcurrent_cpu_time, Scurrent_cpu_time, 0, 0, 0,
+       doc: /* Return the current CPU time along with its resolution.
+The return value is a pair (CPU-TICKS . TICKS-PER-SEC).
+The CPU-TICKS counter can wrap around, so values cannot be meaningfully
+compared if too much time has passed between them.  */)
+  (void)
+{
+  return Fcons (make_int (clock ()), make_int (CLOCKS_PER_SEC));
+}
+#endif
+
 DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string,
        0, 2, 0,
        doc: /* Return the current local time, as a human-readable string.
@@ -2032,6 +2044,9 @@ syms_of_timefns (void)
   DEFSYM (Qencode_time, "encode-time");
 
   defsubr (&Scurrent_time);
+#ifdef CLOCKS_PER_SEC
+  defsubr (&Scurrent_cpu_time);
+#endif
   defsubr (&Stime_convert);
   defsubr (&Stime_add);
   defsubr (&Stime_subtract);
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index ed09203907..fc57271252 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -381,6 +381,36 @@ binding-test-set-constant-nil
   "Test setting a keyword to itself"
   (with-no-warnings (should (setq :keyword :keyword))))
 
+(ert-deftest data-tests--set-default-per-buffer ()
+  :expected-result t ;; Not fixed yet!
+  ;; FIXME: Performance tests are inherently unreliable.
+  ;; Using wall-clock time makes it even worse, so don't bother unless
+  ;; we have the primitive to measure cpu-time.
+  (skip-unless (fboundp 'current-cpu-time))
+  ;; Test performance of set-default on DEFVAR_PER_BUFFER variables.
+  ;; More specifically, test the problem seen in bug#41029 where setting
+  ;; the default value of a variable takes time proportional to the
+  ;; number of buffers.
+  (let* ((fun #'error)
+         (test (lambda ()
+                 (with-temp-buffer
+                   (let ((st (car (current-cpu-time))))
+                     (dotimes (_ 1000)
+                       (let ((case-fold-search 'data-test))
+                         ;; Use an indirection through a mutable var
+                         ;; to try and make sure the byte-compiler
+                         ;; doesn't optimize away the let bindings.
+                         (funcall fun)))
+                     (- (car (current-cpu-time)) st)))))
+         (_ (setq fun #'ignore))
+         (time1 (funcall test))
+         (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
+                       (make-list 1000 nil)))
+         (time2 (funcall test)))
+    (mapc #'kill-buffer bufs)
+    ;; Don't divide one time by the other since they may be 0.
+    (should (< time2 (* time1 5)))))
+
 ;; More tests to write -
 ;; kill-local-variable
 ;; defconst; can modify