tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00
Code Activity

services: shepherd: Add 'shepherd-service-upgrade', from 'guix system'.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès
2016-08-31 15:40:00 +02:00
parent d4f8884fdb
commit 7b44cae50a
4 changed files with 121 additions and 118 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
tests/system.scm
View File

@@ -19,8 +19,6 @@
(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))
@@ -61,12 +59,7 @@
%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")
(test-assert "operating-system-store-file-system"
@@ -121,64 +114,4 @@
(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 (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)