summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-09-02 15:39:50 +0200
committerLudovic Courtès <ludo@gnu.org>2016-09-02 15:39:50 +0200
commit072e10615fc786db02dc44f3cd5f25aed2969111 (patch)
treedbae10eaf8cf13a28c0151a418971fb770243eda /tests
parent3964e358ab65dfd157427560bfb44de8a150068b (diff)
parent135ba811c6f55c22bfa8969143d83e7fdf166763 (diff)
downloadpatches-072e10615fc786db02dc44f3cd5f25aed2969111.tar
patches-072e10615fc786db02dc44f3cd5f25aed2969111.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/cpan.scm4
-rw-r--r--tests/hackage.scm2
-rw-r--r--tests/packages.scm25
-rw-r--r--tests/services.scm79
-rw-r--r--tests/system.scm2
5 files changed, 107 insertions, 5 deletions
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 898081b3e5..80ff044abd 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -66,9 +66,9 @@
(lambda ()
(display
(match url
- ("http://api.metacpan.org/release/Foo-Bar"
+ ("https://api.metacpan.org/release/Foo-Bar"
test-json)
- ("http://api.metacpan.org/module/Test::Script"
+ ("https://api.metacpan.org/module/Test::Script"
"{ \"distribution\" : \"Test-Script\" }")
("http://example.com/Foo-Bar-0.1.tar.gz"
test-source)
diff --git a/tests/hackage.scm b/tests/hackage.scm
index d1ebe37405..a4de8be91e 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -110,7 +110,7 @@ library
('origin
('method 'url-fetch)
('uri ('string-append
- "http://hackage.haskell.org/package/foo/foo-"
+ "https://hackage.haskell.org/package/foo/foo-"
'version
".tar.gz"))
('sha256
diff --git a/tests/packages.scm b/tests/packages.scm
index e9c8690730..daceea5d62 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -742,6 +742,31 @@
(and (build-derivations %store (list drv))
(file-exists? (string-append out "/bin/make")))))))
+(test-assert "package-input-rewriting"
+ (let* ((dep (dummy-package "chbouib"
+ (native-inputs `(("x" ,grep)))))
+ (p0 (dummy-package "example"
+ (inputs `(("foo" ,coreutils)
+ ("bar" ,grep)
+ ("baz" ,dep)))))
+ (rewrite (package-input-rewriting `((,coreutils . ,sed)
+ (,grep . ,findutils))
+ (cut string-append "r-" <>)))
+ (p1 (rewrite p0))
+ (p2 (rewrite p0)))
+ (and (not (eq? p1 p0))
+ (eq? p1 p2) ;memoization
+ (string=? "r-example" (package-name p1))
+ (match (package-inputs p1)
+ ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+ (and (eq? dep1 sed)
+ (eq? dep2 findutils)
+ (string=? (package-name dep3) "r-chbouib")
+ (eq? dep3 (rewrite dep)) ;memoization
+ (match (package-native-inputs dep3)
+ ((("x" dep))
+ (eq? dep findutils)))))))))
+
(test-eq "fold-packages" hello
(fold-packages (lambda (p r)
(if (string=? (package-name p) "hello")
diff --git a/tests/services.scm b/tests/services.scm
index 477a197160..8993c3dafc 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -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"
@@ -105,6 +110,15 @@
(fold-services (list s) #:target-type t1)
#f)))
+(test-assert "shepherd-service-lookup-procedure"
+ (let* ((s1 (shepherd-service (provision '(s1 s1b)) (start #f)))
+ (s2 (shepherd-service (provision '(s2 s2b)) (start #f)))
+ (s3 (shepherd-service (provision '(s3 s3b s3c)) (start #f)))
+ (lookup (shepherd-service-lookup-procedure (list s1 s2 s3))))
+ (and (eq? (lookup 's1) (lookup 's1b) s1)
+ (eq? (lookup 's2) (lookup 's2b) s2)
+ (eq? (lookup 's3) (lookup 's3b) s3))))
+
(test-assert "shepherd-service-back-edges"
(let* ((s1 (shepherd-service (provision '(s1)) (start #f)))
(s2 (shepherd-service (provision '(s2))
@@ -118,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 b5bb9af016..ca34409be9 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -59,7 +59,7 @@
%base-file-systems))
(users %base-user-accounts)))
-
+
(test-begin "system")
(test-assert "operating-system-store-file-system"