aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-08-31 15:40:00 +0200
committerLudovic Courtès <ludo@gnu.org>2016-08-31 15:44:20 +0200
commit7b44cae50aed1d6d67337e9eae9f449ccd00a870 (patch)
treefa0b5237fcc146217dc5ac2210bffac127a0b71c /tests
parentd4f8884fdb897e648fd7f4262b2142d8c363ac76 (diff)
downloadgnu-guix-7b44cae50aed1d6d67337e9eae9f449ccd00a870.tar
gnu-guix-7b44cae50aed1d6d67337e9eae9f449ccd00a870.tar.gz
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.
Diffstat (limited to 'tests')
-rw-r--r--tests/services.scm68
-rw-r--r--tests/system.scm69
2 files changed, 69 insertions, 68 deletions
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)
diff --git a/tests/system.scm b/tests/system.scm
index 9c1a13dd9b..ca34409be9 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -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)