[bug#74670] tests: pack: Fix AppImage tests.

Message ID 87o71g5zrs.fsf@gnu.org
State New
Headers
Series [bug#74670] tests: pack: Fix AppImage tests. |

Commit Message

Ludovic Courtès Dec. 12, 2024, 9:59 p.m. UTC
  Hi Noé,

Noé Lopez <noe@noé.eu> skribis:

> From: Noé Lopez <noelopez@free.fr>
>
> * tests/pack.scm: Add glibc to AppImage tests’ profiles.
>
> Change-Id: I7890b902f65a2944ae8fa03db8a964deda3c725c
> ---
> Hi,
>
> This patch fixes the tests failing for AppImage pack.  I believe the issue was
> that without the AppImage runtime (--appimage-extract-and-run), the glibc is
> not available to the AppRun binary, causing a file not found error.
>
> This is an issue caused because AppRun is built using the relocatable runtime,
> which requires (or at least is built with) the glibc.

Hmm, that further limits the applicability of AppImage, but OK.  (Not
our fault!)

I noticed that the tests were not going very far, so I tried the patch
below to: (1) check the output of ‘hello’ in the first test, (2) change
the second test to check for the existence of /var/guix/db/db.sqlite.

The second test doesn’t work though, because where’s that file supposed
to live?  The image is apparently extracted in an unguessable directory,
so cannot tell where it is.  Am I right?

Thanks,
Ludo’.
  

Patch

diff --git a/tests/pack.scm b/tests/pack.scm
index 2cb643f136..7fcae1ec1f 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -39,9 +39,10 @@  (define-module (test-pack)
   #:use-module ((gnu packages package-management) #:select (rpm))
   #:use-module ((gnu packages compression) #:select (squashfs-tools))
   #:use-module ((gnu packages debian) #:select (dpkg))
-  #:use-module ((gnu packages guile) #:select (guile-sqlite3))
+  #:use-module ((gnu packages guile) #:select (guile-sqlite3 guile-3.0))
   #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
   #:use-module ((gnu packages linux) #:select (fakeroot))
+  #:use-module ((ice-9 textual-ports) #:select (get-string-all))
   #:use-module (srfi srfi-64))
 
 (define %store
@@ -347,7 +348,9 @@  (define rpm-for-tests
     (mlet* %store-monad
         ((guile   (set-guile-for-build (default-guile)))
          (profile -> (profile
-                      (content (packages->manifest (list %bootstrap-guile hello glibc)))
+                      ;; When using '--appimage-extract-and-run', the dynamic
+                      ;; linker is necessary, hence glibc below.
+                      (content (packages->manifest (list hello glibc)))
                       (hooks '())
                       (locales? #f)))
          (image   (self-contained-appimage "hello-appimage" profile
@@ -366,34 +369,46 @@  (define rpm-for-tests
                              (lambda (port)
                                (dump-port pipe port)))
                            (exit (status:exit-val (close-pipe pipe)))))))))
-      (built-derivations (list (pk 'APPIMAGE-drv check)))))
+      (mbegin %store-monad
+        (built-derivations (list (pk 'APPIMAGE-drv check)))
+        (return (string=? (call-with-input-file (derivation->output-path check)
+                            get-string-all)
+                          "Hello, world!\n")))))
 
   (unless store (test-skip 1))
   (test-assertm "appimage + localstatedir"
     (mlet* %store-monad
         ((guile   (set-guile-for-build (default-guile)))
          (profile -> (profile
-                      (content (packages->manifest (list %bootstrap-guile hello glibc)))
+                      ;; When using '--appimage-extract-and-run', the dynamic
+                      ;; linker is necessary, hence glibc below.
+                      (content (packages->manifest (list guile-3.0 glibc)))
                       (hooks '())
                       (locales? #f)))
-         (image   (self-contained-appimage "hello-appimage" profile
-                                           #:entry-point "bin/hello"
+         (image   (self-contained-appimage "guile-appimage" profile
+                                           #:entry-point "bin/guile"
                                            #:localstatedir? #t
                                            #:extra-options
                                            '(#:relocatable? #t)))
          (check   (gexp->derivation
-                   "check-appimage"
-                   (with-imported-modules '((guix build utils))
-                     #~(begin
-                         (use-modules (ice-9 popen)
-                                      (guix build utils))
-                         (let ((pipe (open-pipe* OPEN_READ
-                                                 #$image "--appimage-extract-and-run")))
-                           (call-with-output-file #$output
-                             (lambda (port)
-                               (dump-port pipe port)))
-                           (exit (status:exit-val (close-pipe pipe)))))))))
-      (built-derivations (list (pk 'APPIMAGE-drv check)))))
+                   "check-appimage-with-localstatedir"
+                   #~(begin
+                       (system* #$image "--appimage-extract-and-run" "-c"
+                                (object->string
+                                 `(call-with-output-file #$output
+                                    (lambda (port)
+                                      (display "Hello from Guile!\n"
+                                               port)))))
+                       (execl #$image #$image "--appimage-extract-and-run" "-c"
+                              (object->string
+                               '(exit
+                                 (pk 'db? (getcwd)
+                                     (file-exists? "var/guix/db/db.sqlite")))))))))
+      (mbegin %store-monad
+        (built-derivations (list (pk 'APPIMAGE-drv check)))
+        (return (string=? (call-with-input-file (derivation->output-path check)
+                            get-string-all)
+                          "Hello from Guile!\n")))))
 
   (unless store (test-skip 1))
   (test-assertm "deb archive with symlinks and control files"