diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/services.scm | 68 | ||||
| -rw-r--r-- | tests/system.scm | 69 |
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) |