From 7b44cae50aed1d6d67337e9eae9f449ccd00a870 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 31 Aug 2016 15:40:00 +0200
Subject: services: shepherd: Add 'shepherd-service-upgrade', from 'guix
 system'.

* guix/scripts/system.scm (service-upgrade): Move to...
* gnu/services/shepherd.scm (shepherd-service-upgrade): ... here.
* tests/system.scm ("service-upgrade: nothing to do", "service-upgrade:
one unchanged, one upgraded, one new", "service-upgrade: service
depended on is not unloaded", "service-upgrade: obsolete services that
depend on each other"): Move to...
* tests/services.scm: ... here.  Adjust to 'service-upgrade' rename.
---
 tests/services.scm | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 68 insertions(+)

(limited to 'tests/services.scm')

diff --git a/tests/services.scm b/tests/services.scm
index 12745c8006..8993c3dafc 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -18,12 +18,17 @@
 
 (define-module (test-services)
   #:use-module (gnu services)
+  #:use-module (gnu services herd)
   #:use-module (gnu services shepherd)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64))
 
+(define live-service
+  (@@ (gnu services herd) live-service))
+
+
 (test-begin "services")
 
 (test-assert "service-back-edges"
@@ -127,4 +132,67 @@
          (lset= eq? (e s2) (list s3))
          (null? (e s3)))))
 
+(test-equal "shepherd-service-upgrade: nothing to do"
+  '(() ())
+  (call-with-values
+      (lambda ()
+        (shepherd-service-upgrade '() '()))
+    list))
+
+(test-equal "shepherd-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.
+        (shepherd-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 (map live-service-provision unload)
+            (map shepherd-service-provision load)))))
+
+(test-equal "shepherd-service-upgrade: service depended on is not unloaded"
+  '(((baz))                                       ;unload
+    ())                                           ;load
+  (call-with-values
+      (lambda ()
+        ;; Service 'bar' is not among the target services; yet, it must not be
+        ;; unloaded because 'foo' depends on it.
+        (shepherd-service-upgrade
+         (list (live-service '(foo) '(bar) #t)
+               (live-service '(bar) '() #t)       ;still used!
+               (live-service '(baz) '() #t))
+         (list (shepherd-service (provision '(foo))
+                                 (start #t)))))
+    (lambda (unload load)
+      (list (map live-service-provision unload)
+            (map shepherd-service-provision load)))))
+
+(test-equal "shepherd-service-upgrade: obsolete services that depend on each other"
+  '(((foo) (bar) (baz))                           ;unload
+    ((qux)))                                      ;load
+  (call-with-values
+      (lambda ()
+        ;; 'foo', 'bar', and 'baz' depend on each other, but all of them are
+        ;; obsolete, and thus should be unloaded.
+        (shepherd-service-upgrade
+         (list (live-service '(foo) '(bar) #t)    ;obsolete
+               (live-service '(bar) '(baz) #t)    ;obsolete
+               (live-service '(baz) '() #t))      ;obsolete
+         (list (shepherd-service (provision '(qux))
+                                 (start #t)))))
+    (lambda (unload load)
+      (list (map live-service-provision unload)
+            (map shepherd-service-provision load)))))
+
 (test-end)
-- 
cgit v1.2.3