[elpa] externals/elisp-benchmarks 8a8e9fa6a8: Make it usable on Emacs-27

[Stefan Monnier]

branch: externals/elisp-benchmarks
commit 8a8e9fa6a8c5a24841289a781a75fbb354cf71cb
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    Make it usable on Emacs-27
    
    Also scale some of the benchmarks so they don't take less than 1s on my
    test machine.
    
    * elisp-benchmarks.el (elb-std-deviation): Handle empty list.
    (elisp-benchmarks-run): Catch errors so the benchmark suite can be used
    on Emacs-27 even if not all of the benchmarks can be used.
    
    * benchmarks/pack-unpack.el: Place the old code first so it still gets
    defined even if the new code signals an error.
    * benchmarks/elb-bytecomp.el (elb-bytecomp-entry):
    * benchmarks/elb-eieio.el (elb-eieio-entry):
    * benchmarks/elb-smie.el (elb-smie-entry): Increase run time a bit.
    (elb-smie--boi, elb-smie-mode): Silence some compiler warnings.
---
 benchmarks/elb-bytecomp.el |  2 +-
 benchmarks/elb-eieio.el    |  2 +-
 benchmarks/elb-smie.el     |  4 +--
 benchmarks/fibn.el         |  7 +++--
 benchmarks/pack-unpack.el  | 70 ++++++++++++++++++++++++----------------------
 elisp-benchmarks.el        | 33 ++++++++++++++--------
 6 files changed, 65 insertions(+), 53 deletions(-)

diff --git a/benchmarks/elb-bytecomp.el b/benchmarks/elb-bytecomp.el
index 72fac3681a..3ea91b86f3 100644
--- a/benchmarks/elb-bytecomp.el
+++ b/benchmarks/elb-bytecomp.el
@@ -25,7 +25,7 @@
 ;;; Code:
 
 (defun elb-bytecomp-entry ()
-  (dotimes (_ 30)
+  (dotimes (_ 50)
     (byte-compile-file (expand-file-name "elb-smie.el" elb-bench-directory))))
 
 (provide 'elb-bytecomp)
diff --git a/benchmarks/elb-eieio.el b/benchmarks/elb-eieio.el
index 0241be77d5..a73f226069 100644
--- a/benchmarks/elb-eieio.el
+++ b/benchmarks/elb-eieio.el
@@ -36,7 +36,7 @@
 
 (defun elb-eieio-entry ()
   (let ((total 0))
-    (dotimes (_ 3000)
+    (dotimes (_ 5000)
       (let ((l nil))
         ;; The elb--eieio-length recursion can't deal with more than about
         ;; 150 elements.
diff --git a/benchmarks/elb-smie.el b/benchmarks/elb-smie.el
index 45387f801c..07e0852548 100644
--- a/benchmarks/elb-smie.el
+++ b/benchmarks/elb-smie.el
@@ -474,6 +474,7 @@ if INNER is non-nil, it stops at the innermost one."
                            (guard (when inner
                                     (or (member tok 
elb-smie-paren-block-keywords)
                                         (equal tok "do"))))))
+           (ignore tok)
            (goto-char pos) nil) ;Found it!
           (`(t ,(pred (eq (point-min))) . ,_) nil)
           (`(,_ ,pos . ,_) (goto-char pos) t)))))
@@ -884,7 +885,6 @@ Past this column, we do not try to align the backslashes."
   ;; Backslash auto-realign.
   (add-hook 'after-change-functions #'elb-smie--bs-after-change nil t)
   (add-hook 'post-command-hook #'elb-smie--bs-realign nil t)
-  (setq-local add-log-current-defun-header-regexp elb-smie--def-regexp)
   (setq-local imenu-generic-expression `((nil ,elb-smie--def-regexp 1))))
 
 ;;; The actual benchmark
@@ -894,7 +894,7 @@ Past this column, we do not try to align the backslashes."
     (insert-file-contents (expand-file-name
                            "../resources/xmenu.c" elb-bench-directory))
     (elb-smie-mode)
-    (dotimes (_ 3)
+    (dotimes (_ 5)
       (indent-region (point-min) (point-max)))))
 
 (provide 'elb-smie)
diff --git a/benchmarks/fibn.el b/benchmarks/fibn.el
index b410a2151e..e4440d3cf7 100644
--- a/benchmarks/fibn.el
+++ b/benchmarks/fibn.el
@@ -60,9 +60,10 @@
         b
       (loop (+ a b) a (- count 1)))))
 
-(defun elb-fibn-named-let-entry ()
-  (dotimes (_ 1000000)
-    (elb-fibn-named-let 80)))
+(when (fboundp 'named-let)
+  (defun elb-fibn-named-let-entry ()
+    (dotimes (_ 1000000)
+      (elb-fibn-named-let 80))))
 
 ;; Fibonacci sequence with the naive recursive algo.
 
diff --git a/benchmarks/pack-unpack.el b/benchmarks/pack-unpack.el
index d05571e456..f43c01f0be 100644
--- a/benchmarks/pack-unpack.el
+++ b/benchmarks/pack-unpack.el
@@ -1,6 +1,6 @@
 ;;; benchmarks/pack-unpack.el --- Packing and unpacking binary data  -*- 
lexical-binding: t; -*-
 
-;; Copyright (C) 2021  Free Software Foundation, Inc.
+;; Copyright (C) 2021-2022  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords:
@@ -45,32 +45,6 @@
 
 (require 'bindat)
 
-(bindat-defmacro ip () "An IPv4 address"     '(vec 4 byte))
-
-(defconst header-bindat-type
-  (bindat-type
-    (dest-ip ip)
-    (src-ip ip)
-    (dest-port uint 16)
-    (src-port uint 16)))
-
-(defconst data-bindat-type
-  (bindat-type
-    (type u8)
-    (opcode u8)
-    (length uintr 16) ;; little endian order
-    (id strz 8)
-    (data vec length)
-    (_ align 4)))
-
-(defconst packet-bindat-type
-  (bindat-type
-    (header type header-bindat-type)
-    (items u8)
-    (_ fill 3)
-    (item repeat items
-          (_ type data-bindat-type))))
-
 (defconst struct-bindat
   '((header
      (dest-ip . [192 168 1 100])
@@ -89,12 +63,7 @@
            (id . "BCDEFG")
            (data . [6 7 8 9 10 11 12])))))
 
-(defun elb-pack-unpack-entry ()
-  (dotimes (_ 10000)
-    (bindat-unpack packet-bindat-type
-                   (bindat-pack packet-bindat-type struct-bindat))))
-
-;;;; Same code but using the old API
+;;;; First using the old API
 
 (defconst header-bindat-spec
   '((dest-ip ip)
@@ -118,9 +87,42 @@
           (struct data-bindat-spec))))
 
 (defun elb-pack-unpack-old-entry ()
-  (dotimes (_ 10000)
+  (dotimes (_ 40000)
     (bindat-unpack packet-bindat-spec
                    (bindat-pack packet-bindat-spec struct-bindat))))
 
+;;;; Then using the new API
+
+(bindat-defmacro ip () "An IPv4 address"     '(vec 4 byte))
+
+(defconst header-bindat-type
+  (bindat-type
+    (dest-ip ip)
+    (src-ip ip)
+    (dest-port uint 16)
+    (src-port uint 16)))
+
+(defconst data-bindat-type
+  (bindat-type
+    (type u8)
+    (opcode u8)
+    (length uintr 16) ;; little endian order
+    (id strz 8)
+    (data vec length)
+    (_ align 4)))
+
+(defconst packet-bindat-type
+  (bindat-type
+    (header type header-bindat-type)
+    (items u8)
+    (_ fill 3)
+    (item repeat items
+          (_ type data-bindat-type))))
+
+(defun elb-pack-unpack-entry ()
+  (dotimes (_ 40000)
+    (bindat-unpack packet-bindat-type
+                   (bindat-pack packet-bindat-type struct-bindat))))
+
 (provide 'benchmarks/pack-unpack)
 ;;; benchmarks/pack-unpack.el ends here
diff --git a/elisp-benchmarks.el b/elisp-benchmarks.el
index 4fe10b87a4..f6943b9784 100644
--- a/elisp-benchmarks.el
+++ b/elisp-benchmarks.el
@@ -77,7 +77,7 @@
   (let* ((n (length list))
         (mean (/ (cl-loop for x in list
                           sum x)
-                 n)))
+                 (max n 1))))
     (sqrt (/ (cl-loop for x in list
                   sum (expt (- x mean) 2))
          (1- n)))))
@@ -110,18 +110,22 @@ RECOMPILE all the benchmark folder when non nil."
              (funcall compile-function f))
            test-sources))
     ;; Load
-    (mapc #'load (mapcar (if (and (featurep 'native-compile)
-                                 (fboundp 'comp-el-to-eln-filename))
-                            ;; FIXME: Isn't the elc->eln
-                             ;; remapping fully automatic?
-                            #'comp-el-to-eln-filename
-                          #'file-name-sans-extension)
-                        test-sources))
+    (mapc (lambda (file)
+           (with-demoted-errors "Error loading: %S"
+             (load file)))
+         (mapcar (if (and (featurep 'native-compile)
+                          (fboundp 'comp-el-to-eln-filename))
+                     ;; FIXME: Isn't the elc->eln
+                      ;; remapping fully automatic?
+                     #'comp-el-to-eln-filename
+                   #'file-name-sans-extension)
+                 test-sources))
     (let ((tests (let ((names '()))
                   (mapatoms (lambda (s)
                              (let ((name (symbol-name s)))
-                               (when (string-match
-                                      "\\`elb-\\(.*\\)-entry\\'" name)
+                               (when (and (fboundp s)
+                                          (string-match
+                                           "\\`elb-\\(.*\\)-entry\\'" name))
                                  (push (match-string 1 name) names)))))
                   (sort names #'string-lessp))))
       ;; (cl-loop for test in tests
@@ -137,9 +141,14 @@ RECOMPILE all the benchmark folder when non nil."
                        do
                        (garbage-collect)
                        (message "Running %s..." test)
-                       (push (eval `(benchmark-run nil (,entry-point)) t)
-                             (gethash test res)))
+                       (let ((time
+                              (with-demoted-errors "Error running: %S"
+                               (eval `(benchmark-run nil (,entry-point)) t))))
+                         (when time
+                           (push time (gethash test res)))))
               finally
+              (setq debug-on-error t)
+
               (pop-to-buffer elb-result-buffer-name)
               (erase-buffer)
               (insert "* Results\n\n")