modified   system-tests/gnome-desktop.scm
@@ -5,18 +5,61 @@
 (define-module (system-tests gnome-desktop)
   #:use-module (gnu services desktop)
   #:use-module (gnu services)
-  #:use-module (gnu system vm)
   #:use-module (gnu system)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system vm)
   #:use-module (gnu tests)
   #:use-module (guix gexp)
-  #:use-module (guix modules))
+  #:use-module (guix git-download)
+  #:use-module (guix modules)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix utils)
+  #:use-module (guix transformations))
 
-(define gnome-desktop-operating-system
-  (operating-system
-    (inherit %simple-os)
-    (services
-     (cons* (service gnome-desktop-service-type)
-            %desktop-services))))
+;;; For a manual test/inspection:
+#;(
+
+$(./pre-inst-env guix system vm --no-grafts \
+-e "(@@ (system-tests gnome-desktop) gnome-desktop-os)") \
+-display gtk,gl=on -m 1024
+
+)
+
+(define source-checkout
+  (local-file
+   ".." "gnome-session-shepherd-checkout"
+   #:recursive? #t
+   #:select? (git-predicate
+              (or (false-if-exception (dirname (current-source-directory)))
+                  (begin                ;XXX: for REPL
+                    (format (current-warning-port)
+                            "assuming CWD is at root of project~%")
+                    (getcwd))))))
+
+(define current-source-checkout
+  (with-store store
+    (run-with-store store (lower-object source-checkout))))
+
+(define with-this-gnome-session-shepherd
+  (options->transformation
+   `((with-source . ,(string-append "gnome-session-shepherd="
+                                    current-source-checkout)))))
+
+(define gnome-desktop-os
+  (with-this-gnome-session-shepherd
+   (operating-system
+     (inherit %simple-os)
+     (users (cons (user-account
+                    (name "alice")
+                    (password "")
+                    (comment "Bob's sister")
+                    (group "users")
+                    (supplementary-groups '("wheel" "audio" "video")))
+                  %base-user-accounts))
+     (services
+      (cons* (service gnome-desktop-service-type)
+             %desktop-services)))))
 
 (define (run-gnome-desktop-test os vm)
   (gexp->derivation
@@ -90,12 +133,14 @@
    (description "Test whether we can log in and log out of the GNOME desktop")
    (value
     (let* ((os (marionette-operating-system
-                gnome-desktop-operating-system
+                gnome-desktop-os
                 #:imported-modules
                 (source-module-closure
                  '((shepherd comm))
                  #:select? (lambda (name) (eq? 'shepherd (car name))))))
-           (vm (virtual-machine os)))
+           (vm (virtual-machine
+                 (operating-system os)
+                 (memory-size 1024))))
       (run-gnome-desktop-test (virtualized-operating-system os '())
                               #~(list #$vm))))))
 

[back]