[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
07/08: guix system: Do not unload services depended on.
From: |
Ludovic Courtès |
Subject: |
07/08: guix system: Do not unload services depended on. |
Date: |
Wed, 31 Aug 2016 14:14:00 +0000 (UTC) |
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)
- branch master updated (c180533 -> 7b44cae), Ludovic Courtès, 2016/08/31
- 04/08: services: shepherd: Add 'shepherd-service-lookup-procedure'., Ludovic Courtès, 2016/08/31
- 06/08: services: shepherd: Parameterize 'shepherd-service-back-edges'., Ludovic Courtès, 2016/08/31
- 01/08: doc: Fix 'ntp-service' typo., Ludovic Courtès, 2016/08/31
- 08/08: services: shepherd: Add 'shepherd-service-upgrade', from 'guix system'., Ludovic Courtès, 2016/08/31
- 07/08: guix system: Do not unload services depended on.,
Ludovic Courtès <=
- 02/08: services: herd: Provide <live-service> objects., Ludovic Courtès, 2016/08/31
- 03/08: guix system: Extract and test the service upgrade procedure., Ludovic Courtès, 2016/08/31
- 05/08: guix system: Use 'shepherd-service-lookup-procedure' in 'service-upgrade'., Ludovic Courtès, 2016/08/31