summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/containers.scm9
-rw-r--r--tests/grafts.scm48
-rw-r--r--tests/lint.scm8
-rw-r--r--tests/scripts-build.scm19
-rw-r--r--tests/syscalls.scm35
5 files changed, 104 insertions, 15 deletions
diff --git a/tests/containers.scm b/tests/containers.scm
index bbcff3f51f..698bef3e47 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -162,4 +162,13 @@
(waitpid pid)
(zero? result)))))))
+(skip-if-unsupported)
+(test-equal "container-excursion, same namespaces"
+ 42
+ ;; The parent and child are in the same namespaces. 'container-excursion'
+ ;; should notice that and avoid calling 'setns' since that would fail.
+ (container-excursion (getpid)
+ (lambda ()
+ (primitive-exit 42))))
+
(test-end)
diff --git a/tests/grafts.scm b/tests/grafts.scm
index 4eff06b4b3..6454a03b1f 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -201,6 +201,54 @@
(and (string=? (readlink one) repl)
(string=? (readlink two) one))))))
+(test-assert "graft-derivation, replaced derivation has multiple outputs"
+ ;; Here we have a replacement just for output "one" of P1 and not for the
+ ;; other output. Make sure the graft for P1:one correctly applies to the
+ ;; dependents of P1. See <http://bugs.gnu.org/24712>.
+ (let* ((p1 (build-expression->derivation
+ %store "p1"
+ `(let ((one (assoc-ref %outputs "one"))
+ (two (assoc-ref %outputs "two")))
+ (mkdir one)
+ (mkdir two))
+ #:outputs '("one" "two")))
+ (p1r (build-expression->derivation
+ %store "P1"
+ `(let ((other (assoc-ref %outputs "ONE")))
+ (mkdir other)
+ (call-with-output-file (string-append other "/replacement")
+ (const #t)))
+ #:outputs '("ONE")))
+ (p2 (build-expression->derivation
+ %store "p2"
+ `(let ((out (assoc-ref %outputs "aaa")))
+ (mkdir (assoc-ref %outputs "zzz"))
+ (mkdir out) (chdir out)
+ (symlink (assoc-ref %build-inputs "p1:one") "one")
+ (symlink (assoc-ref %build-inputs "p1:two") "two"))
+ #:outputs '("aaa" "zzz")
+ #:inputs `(("p1:one" ,p1 "one")
+ ("p1:two" ,p1 "two"))))
+ (p3 (build-expression->derivation
+ %store "p3"
+ `(symlink (assoc-ref %build-inputs "p2:aaa")
+ (assoc-ref %outputs "out"))
+ #:inputs `(("p2:aaa" ,p2 "aaa")
+ ("p2:zzz" ,p2 "zzz"))))
+ (p1g (graft
+ (origin p1)
+ (origin-output "one")
+ (replacement p1r)
+ (replacement-output "ONE")))
+ (p3d (graft-derivation %store p3 (list p1g))))
+ (and (build-derivations %store (list p3d))
+ (let ((out (derivation->output-path (pk 'p2d p3d))))
+ (and (not (string=? (readlink out)
+ (derivation->output-path p2 "aaa")))
+ (string=? (derivation->output-path p1 "two")
+ (readlink (string-append out "/two")))
+ (file-exists? (string-append out "/one/replacement")))))))
+
(test-assert "graft-derivation, renaming" ;<http://bugs.gnu.org/23132>
(let* ((build `(begin
(use-modules (guix build utils))
diff --git a/tests/lint.scm b/tests/lint.scm
index d692b42f93..fa2d19b2a6 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -218,6 +218,14 @@ string) on HTTP requests."
(check-description-style pkg)))
"should not contain trademark sign"))))
+(test-assert "description: suggest ornament instead of quotes"
+ (->bool
+ (string-contains (with-warnings
+ (let ((pkg (dummy-package "x"
+ (description "This is a 'quoted' thing."))))
+ (check-description-style pkg)))
+ "use @code")))
+
(test-assert "synopsis: not a string"
(->bool
(string-contains (with-warnings
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index e48c8da264..b324012806 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -102,4 +102,23 @@
((("x" dep))
(eq? dep findutils)))))))))))
+(test-assert "options->transformation, with-graft"
+ (let* ((p (dummy-package "guix.scm"
+ (inputs `(("foo" ,grep)
+ ("bar" ,(dummy-package "chbouib"
+ (native-inputs `(("x" ,grep)))))))))
+ (t (options->transformation '((with-graft . "grep=findutils")))))
+ (with-store store
+ (let ((new (t store p)))
+ (and (not (eq? new p))
+ (match (package-inputs new)
+ ((("foo" dep1) ("bar" dep2))
+ (and (string=? (package-full-name dep1)
+ (package-full-name grep))
+ (eq? (package-replacement dep1) findutils)
+ (string=? (package-name dep2) "chbouib")
+ (match (package-native-inputs dep2)
+ ((("x" dep))
+ (eq? (package-replacement dep) findutils)))))))))))
+
(test-end)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 73fa8a7acf..1b31d87f23 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -148,25 +148,30 @@
(unless perform-container-tests?
(test-skip 1))
-(test-assert "pivot-root"
+(test-equal "pivot-root"
+ #t
(match (pipe)
((in . out)
(match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
(0
- (close in)
- (call-with-temporary-directory
- (lambda (root)
- (let ((put-old (string-append root "/real-root")))
- (mount "none" root "tmpfs")
- (mkdir put-old)
- (call-with-output-file (string-append root "/test")
- (lambda (port)
- (display "testing\n" port)))
- (pivot-root root put-old)
- ;; The test file should now be located inside the root directory.
- (write (file-exists? "/test") out)
- (close out))))
- (primitive-exit 0))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (close in)
+ (call-with-temporary-directory
+ (lambda (root)
+ (let ((put-old (string-append root "/real-root")))
+ (mount "none" root "tmpfs")
+ (mkdir put-old)
+ (call-with-output-file (string-append root "/test")
+ (lambda (port)
+ (display "testing\n" port)))
+ (pivot-root root put-old)
+ ;; The test file should now be located inside the root directory.
+ (write (file-exists? "/test") out)
+ (close out)))))
+ (lambda ()
+ (primitive-exit 0))))
(pid
(close out)
(let ((result (read in)))