From b8692e4696d0d2b36466827da1e0d25d69a298af Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 30 Aug 2016 22:40:24 +0200
Subject: guix system: Extract and test the service upgrade procedure.

* guix/scripts/system.scm (service-upgrade): New procedure, with code
from...
(call-with-service-upgrade-info): ... here.  Use it.
* tests/system.scm (live-service, service-upgrade): New variables.
("service-upgrade: nothing to do", "service-upgrade: one unchanged, one
upgraded, one new"): New tests.
---
 tests/system.scm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

(limited to 'tests/system.scm')

diff --git a/tests/system.scm b/tests/system.scm
index b5bb9af016..dee6feda2c 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -19,6 +19,8 @@
 (define-module (test-system)
   #:use-module (gnu)
   #:use-module (guix store)
+  #:use-module (gnu services herd)
+  #:use-module (gnu services shepherd)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64))
 
@@ -59,6 +61,11 @@ (define %os-with-mapped-device
                         %base-file-systems))
     (users %base-user-accounts)))
 
+(define live-service
+  (@@ (gnu services herd) live-service))
+
+(define service-upgrade
+  (@@ (guix scripts system) service-upgrade))
 
 (test-begin "system")
 
@@ -114,4 +121,31 @@ (define %os-with-mapped-device
                            (type "ext4"))
                          %base-file-systems)))))
 
+(test-equal "service-upgrade: nothing to do"
+  '(() ())
+  (call-with-values
+      (lambda ()
+        (service-upgrade '() '()))
+    list))
+
+(test-equal "service-upgrade: one unchanged, one upgraded, one new"
+  '((bar)                                         ;unload
+    ((bar) (baz)))                                ;load
+  (call-with-values
+      (lambda ()
+        ;; Here 'foo' is not upgraded because it is still running, whereas
+        ;; 'bar' is upgraded because it is not currently running.  'baz' is
+        ;; loaded because it's a new service.
+        (service-upgrade (list (live-service '(foo) '() #t)
+                               (live-service '(bar) '() #f)
+                               (live-service '(root) '() #t)) ;essential!
+                         (list (shepherd-service (provision '(foo))
+                                                 (start #t))
+                               (shepherd-service (provision '(bar))
+                                                 (start #t))
+                               (shepherd-service (provision '(baz))
+                                                 (start #t)))))
+    (lambda (unload load)
+      (list unload (map shepherd-service-provision load)))))
+
 (test-end)
-- 
cgit v1.2.3