03/07: gnu: emacs: Check integrity of native-compiled files.

[guix-commits]

lilyp pushed a commit to branch emacs-team
in repository guix.

commit 35fc3027f372eddbd21a2c6b5a591453591a6825
Author: Liliana Marie Prikler <liliana.prikler@gmail.com>
AuthorDate: Sat Feb 24 07:18:52 2024 +0100

    gnu: emacs: Check integrity of native-compiled files.
    
    In the previous commit, we've added a patch that potentially messes with
    how built-in (especially preloaded) Lisp libraries are loaded.  Thus, we
    might want to assert that these files still load fine, as reported when
    querying the builtin documentation of functions provided by them.
    
    * gnu/packages/aux-files/emacs/comp-integrity.el: New file.
    * gnu/Makefile.am (dist_noinst_DATA): Register it here.
    * gnu/packages/emacs.scm (emacs-no-x)[#:phases]: Add 
‘validate-comp-integrity’.
---
 Makefile.am                                    |   1 +
 gnu/packages/aux-files/emacs/comp-integrity.el | 126 +++++++++++++++++++++++++
 gnu/packages/emacs.scm                         |  13 ++-
 3 files changed, 139 insertions(+), 1 deletion(-)

diff --git a/Makefile.am b/Makefile.am
index d3b9532c7a..6837c4c87c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -421,6 +421,7 @@ dist_noinst_DATA =                          \
 # Auxiliary files for packages.
 AUX_FILES =                                            \
   gnu/packages/aux-files/chromium/master-preferences.json              \
+  gnu/packages/aux-files/emacs/comp-integrity.el               \
   gnu/packages/aux-files/emacs/guix-emacs.el           \
   gnu/packages/aux-files/findclass.php                 \
   gnu/packages/aux-files/guix.vim                      \
diff --git a/gnu/packages/aux-files/emacs/comp-integrity.el 
b/gnu/packages/aux-files/emacs/comp-integrity.el
new file mode 100644
index 0000000000..ed6a348fed
--- /dev/null
+++ b/gnu/packages/aux-files/emacs/comp-integrity.el
@@ -0,0 +1,126 @@
+(require 'ert)
+
+(eval-when-compile
+  (require 'help-fns)
+
+  (defmacro expect-help (fun result &optional feature)
+    `(progn
+       (eval-when-compile (when ',feature
+                            (require ',feature)))
+
+       (ert-deftest ,(intern (concat "expect-" (symbol-name fun)
+                                     "-" (symbol-name result)))
+           ()
+           (should
+            (eq ',result
+                (let ((desc (substring-no-properties
+                             (with-output-to-string
+                               (help-fns-function-description-header ',fun)))))
+                  (cond ((string-search "native-compiled" desc) 'native)
+                        ((string-search "byte-compiled" desc) 'byte)
+                        ((string-search "built-in" desc) 'built-in)
+                        (t nil))))))))
+
+  (defmacro expect-native (fun &optional feature)
+    `(progn (expect-help ,fun native ,feature)))
+
+  (defmacro expect-builtin (fun &optional feature)
+    `(progn (expect-help ,fun built-in ,feature))))
+
+(expect-native abbrev-mode)
+(expect-native backquote-process)
+(expect-native mode-line-widen)
+(expect-native buffer-menu)
+(expect-native button-mode)
+(expect-native byte-run-strip-symbol-positions)
+(expect-native case-table-get-table)
+(expect-native cconv-convert)
+(expect-native use-default-char-width-table)
+(expect-native cl-generic-p)
+(expect-native cl-struct-define)
+(expect-native x-setup-function-keys)
+(expect-native encode-composition-rule)
+(expect-native custom-declare-face)
+(expect-native minibuffer-prompt-properties--setter)
+(expect-native custom-add-choice)
+(expect-native debug-early)
+(expect-native display-table-slot disp-table)
+(expect-native dnd-open-file)
+(expect-native dos-mode25 dos-fns)
+(expect-native find-file-text dos-w32)
+(expect-native dynamic-setting-handle-config-changed-event)
+(expect-native easy-menu-item-present-p)
+(expect-native eldoc-mode)
+(expect-native electric-indent-mode)
+(expect-native elisp-mode-syntax-propertize)
+(expect-native getenv)
+(expect-native epa-file-find-file-hook)
+(expect-native face-list)
+(expect-native find-file-noselect)
+(expect-native fill-region)
+(expect-native font-lock-change-mode)
+(expect-native font-lock-add-keywords)
+(expect-native fontset-plain-name)
+(expect-native format-read)
+(expect-native frame-edges)
+(expect-native fringe-mode)
+(expect-native help-quick)
+(expect-native image-type)
+(expect-native indent-region)
+(expect-native indian-compose-regexp)
+(expect-native msdos-setup-keyboard term/internal)
+(expect-native isearch-abort)
+(expect-native iso-transl-set-language)
+(expect-native jit-lock-mode)
+(expect-native jka-compr-build-file-regexp)
+(expect-native keymap-global-set)
+(expect-native forward-sexp)
+(expect-native lisp-string-in-doc-position-p)
+(expect-native ls-lisp-set-options ls-lisp)
+(expect-native macroexp-compiling-p)
+(expect-native map-y-or-n-p)
+(expect-native menu-find-file-existing)
+(expect-native completion-boundaries)
+(expect-native egyptian-shape-grouping)
+(expect-native mouse-double-click-time)
+(expect-native convert-define-charset-argument)
+(expect-native coding-system-change-eol-conversion)
+(expect-native store-substring mule-util)
+(expect-native mouse-wheel-change-button)
+(expect-native advice-function-mapc)
+(expect-native comment-string-strip)
+(expect-native obarray-make)
+(expect-native oclosure-type)
+(expect-native forward-page)
+(expect-native sentence-end)
+(expect-native show-paren-function)
+(expect-native pgtk-dnd-init-frame pgtk-dnd)
+(expect-native prog-context-menu)
+(expect-native regexp-opt)
+(expect-native get-register)
+(expect-native query-replace-descr)
+(expect-native rfn-eshadow-setup-minibuffer)
+(expect-native read-multiple-choice)
+(expect-native scroll-bar-scale)
+(expect-native gui-select-text)
+(expect-native seq-first)
+(expect-native hack-read-symbol-shorthands)
+(expect-native next-error-find-buffer)
+(expect-native exit-splash-screen)
+(expect-native buffer-local-boundp)
+(expect-native syntax-propertize-multiline)
+(expect-native tab-bar-mode)
+(expect-native tabulated-list-put-tag)
+(expect-native text-mode)
+(expect-native timer-activate)
+(expect-native tool-bar-mode)
+(expect-native tooltip-mode)
+(expect-native tty-color-desc)
+(expect-native ucs-normalize-hfs-nfd-comp-p ucs-normalize)
+(expect-native uniquify-item-p)
+(expect-native vc-mode)
+(expect-native emacs-version)
+(expect-native define-widget)
+(expect-native window-right)
+(expect-native x-dnd-init-frame)
+(expect-native x-handle-no-bitmap-icon)
diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm
index 182de0204d..f0200ad27c 100644
--- a/gnu/packages/emacs.scm
+++ b/gnu/packages/emacs.scm
@@ -380,7 +380,18 @@ editor (console only)")
                      "-B" #$(this-package-input "libgccjit") "/lib/gcc/"))))))
             (add-after 'build 'build-trampolines
               (lambda* (#:key make-flags #:allow-other-keys)
-                (apply invoke "make" "trampolines" make-flags)))))))
+                (apply invoke "make" "trampolines" make-flags)))
+            (add-after 'validate-runpath 'validate-comp-integrity
+              (lambda* (#:key outputs #:allow-other-keys)
+                (if #$(%current-target-system)
+                    (display "Cannot validate native-comp on cross builds.\n")
+                    (invoke
+                     (string-append (assoc-ref outputs "out") "/bin/emacs")
+                     "--batch"
+                     "--load"
+                     #$(local-file
+                        (search-auxiliary-file "emacs/comp-integrity.el"))
+                     "-f" "ert-run-tests-batch-and-exit"))))))))
     (inputs
      (modify-inputs (package-inputs emacs-minimal)
        (prepend gnutls