bug#72045: [PATCH v2 1/2] gnu: Add system test for Emacs.

[Liliana Marie Prikler <liliana.prikler@gmail.com>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 4746 bytes --]

* gnu/tests/emacs.scm: New file.
---
Hi Guix,

this series adds a system test to ensure that Emacs grafts are meaningful.
With this, we can make safe decisions as to whether or not place
(replacement …)

Cheers

 gnu/tests/emacs.scm | 100 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 gnu/tests/emacs.scm

diff --git a/gnu/tests/emacs.scm b/gnu/tests/emacs.scm
new file mode 100644
index 0000000000..fba27cefd8
--- /dev/null
+++ b/gnu/tests/emacs.scm
@@ -0,0 +1,100 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests emacs)
+  #:use-module (gnu tests)
+  #:use-module (gnu packages emacs)
+  #:use-module (gnu packages vim)
+  #:use-module (gnu services)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
+  #:export (%test-emacs-native-comp-replacable))
+
+(define (run-native-comp-replacable-test old-emacs new-emacs)
+  (define vm (virtual-machine (marionette-operating-system %simple-os)))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-1)
+                       (srfi srfi-64))
+
+          (define marionette (make-marionette (list #$vm)))
+          (define (emacs-native-comp-dir emacs)
+            (marionette-eval
+             `(begin
+                (use-modules (ice-9 rdelim) (ice-9 popen))
+                (read-line
+                 (open-pipe*
+                  OPEN_READ
+                  ,emacs "--batch"
+                  "--eval=(princ comp-native-version-dir)")))
+             marionette))
+          (define (emacs-effective-version emacs)
+            (marionette-eval
+             `(begin
+                (use-modules (ice-9 rdelim) (ice-9 popen))
+                (read-line
+                 (open-pipe*
+                  OPEN_READ
+                  ,emacs "--batch"
+                  "--eval=(princ (format \"%s.%s\" \
+                           emacs-major-version emacs-minor-version))")))
+             marionette))
+          (define old-emacs-bin #$(file-append old-emacs "/bin/emacs"))
+          (define new-emacs-bin #$(file-append new-emacs "/bin/emacs"))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "emacs-native-comp-replacable")
+          (test-equal "native-comp-dir"
+            (emacs-native-comp-dir
+             #$(file-append old-emacs "/bin/emacs"))
+            (emacs-native-comp-dir
+             #$(file-append new-emacs "/bin/emacs")))
+          (test-assert "old emacs has hierarchical layout"
+            (file-exists?
+             (string-append #$new-emacs "/lib/emacs/"
+                            (emacs-effective-version old-emacs-bin)
+                            "/native-lisp/"
+                            (emacs-native-comp-dir old-emacs-bin)
+                            "/preloaded/emacs-lisp/comp.eln")))
+          (test-assert "new emacs has hierarchical layout"
+            (file-exists?
+             (string-append #$new-emacs "/lib/emacs/"
+                            (emacs-effective-version new-emacs-bin)
+                            "/native-lisp/"
+                            (emacs-native-comp-dir new-emacs-bin)
+                            "/preloaded/emacs-lisp/comp.eln")))
+          (test-end))))
+
+  (gexp->derivation "emacs-native-comp-compatible" test))
+
+(define (package-without-replacement pkg)
+  (package (inherit pkg) (replacement #f)))
+
+(define %test-emacs-native-comp-replacable
+  (system-test
+   (name "emacs-native-comp")
+   (description "Test whether an emacs replacement (if any) is valid.")
+   (value (run-native-comp-replacable-test
+           (package-without-replacement emacs)
+           emacs))))

base-commit: e3dfed59d39ac60dd2e2b9ef9f4ef63a2a081f41
-- 
2.45.2