07/08: guix system: Do not unload services depended on.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d4f8884fdb897e648fd7f4262b2142d8c363ac76
Author: Ludovic Courtès <address@hidden>
Date:   Wed Aug 31 15:23:32 2016 +0200

    guix system: Do not unload services depended on.
    
    Reported by Mark H Weaver <address@hidden>
    at <https://lists.gnu.org/archive/html/guix-devel/2016-08/msg01470.html>.
    
    * guix/scripts/system.scm (service-upgrade)[live-service-required?]: New
    procedure.
    [obsolete?]: Use it.
    * tests/system.scm ("service-upgrade: service depended on is not
    unloaded", "service-upgrade: obsolete services that depend on each
    other"): New tests.
---
 guix/scripts/system.scm |    7 ++++++-
 tests/system.scm        |   32 ++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 80f62fb..bcf19db 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -298,9 +298,14 @@ needs to be loaded."
       (service (and (not (live-service-running service))
                     service))))
 
+  (define live-service-dependents
+    (shepherd-service-back-edges live
+                                 #:provision live-service-provision
+                                 #:requirement live-service-requirement))
+
   (define (obsolete? service)
     (match (lookup-target (first (live-service-provision service)))
-      (#f #t)
+      (#f (every obsolete? (live-service-dependents service)))
       (_  #f)))
 
   (define to-load
diff --git a/tests/system.scm b/tests/system.scm
index eff9970..9c1a13d 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -149,4 +149,36 @@
       (list (map live-service-provision unload)
             (map shepherd-service-provision load)))))
 
+(test-equal "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.
+        (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 "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.
+        (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)