aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2018-03-27 20:05:58 -0400
committerMark H Weaver <mhw@netris.org>2018-03-27 21:35:43 -0400
commit1e868858fd2de0d1125e6191be5e28df22fe6665 (patch)
treeb18fbcb775fa8f79cf12402cf67a6d249e9a742a
parente3cfef22c4a18cacf33356a70788503fd689b96d (diff)
downloadpatches-1e868858fd2de0d1125e6191be5e28df22fe6665.tar
patches-1e868858fd2de0d1125e6191be5e28df22fe6665.tar.gz
tests: Use invoke and return #t from all builders.
* tests/packages.scm ("package-source-derivation, snippet", "trivial") ("trivial with local file as input", "trivial with source") ("trivial with system-dependent input", "trivial with #:allowed-references") ("--search-paths with pattern", "--search-paths with single-item search path") ("replacement also grafted"): In the builders, raise an exception on errors and otherwise return #t. Use invoke.
-rw-r--r--tests/packages.scm77
-rw-r--r--tests/profiles.scm6
2 files changed, 54 insertions, 29 deletions
diff --git a/tests/packages.scm b/tests/packages.scm
index 9e19c3992e..f1e7d3119b 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -407,18 +407,23 @@
(%current-system)))))
(arguments
`(#:guile ,%bootstrap-guile
+ #:modules ((guix build utils))
#:builder
- (let ((tar (assoc-ref %build-inputs "tar"))
- (xz (assoc-ref %build-inputs "xz"))
- (source (assoc-ref %build-inputs "source")))
- (and (zero? (system* tar "xvf" source
- "--use-compress-program" xz))
- (string=? "guile" (readlink "bin/guile-rocks"))
- (file-exists? "bin/scripts/compile.scm")
- (let ((out (assoc-ref %outputs "out")))
- (call-with-output-file out
- (lambda (p)
- (display "OK" p))))))))))
+ (begin
+ (use-modules (guix build utils))
+ (let ((tar (assoc-ref %build-inputs "tar"))
+ (xz (assoc-ref %build-inputs "xz"))
+ (source (assoc-ref %build-inputs "source")))
+ (invoke tar "xvf" source
+ "--use-compress-program" xz)
+ (unless (and (string=? "guile" (readlink "bin/guile-rocks"))
+ (file-exists? "bin/scripts/compile.scm"))
+ (error "the snippet apparently failed"))
+ (let ((out (assoc-ref %outputs "out")))
+ (call-with-output-file out
+ (lambda (p)
+ (display "OK" p))))
+ #t))))))
(drv (package-derivation %store package))
(out (derivation->output-path drv)))
(and (build-derivations %store (list (pk 'snippet-drv drv)))
@@ -486,7 +491,8 @@
(mkdir %output)
(call-with-output-file (string-append %output "/test")
(lambda (p)
- (display '(hello guix) p))))))))
+ (display '(hello guix) p)))
+ #t)))))
(d (package-derivation %store p)))
(and (build-derivations %store (list d))
(let ((p (pk 'drv d (derivation->output-path d))))
@@ -500,8 +506,10 @@
(source #f)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (copy-file (assoc-ref %build-inputs "input")
- %output)))
+ #:builder (begin
+ (copy-file (assoc-ref %build-inputs "input")
+ %output)
+ #t)))
(inputs `(("input" ,i)))))
(d (package-derivation %store p)))
(and (build-derivations %store (list d))
@@ -516,8 +524,10 @@
(source i)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (copy-file (assoc-ref %build-inputs "source")
- %output)))))
+ #:builder (begin
+ (copy-file (assoc-ref %build-inputs "source")
+ %output)
+ #t)))))
(d (package-derivation %store p)))
(and (build-derivations %store (list d))
(let ((p (derivation->output-path d)))
@@ -530,11 +540,14 @@
(source #f)
(arguments
`(#:guile ,%bootstrap-guile
+ #:modules ((guix build utils))
#:builder
- (let ((out (assoc-ref %outputs "out"))
- (bash (assoc-ref %build-inputs "bash")))
- (zero? (system* bash "-c"
- (format #f "echo hello > ~a" out))))))
+ (begin
+ (use-modules (guix build utils))
+ (let ((out (assoc-ref %outputs "out"))
+ (bash (assoc-ref %build-inputs "bash")))
+ (invoke bash "-c"
+ (format #f "echo hello > ~a" out))))))
(inputs `(("bash" ,(search-bootstrap-binary "bash"
(%current-system)))))))
(d (package-derivation %store p)))
@@ -554,7 +567,8 @@
(mkdir %output)
;; The reference to itself isn't allowed so building it
;; should fail.
- (symlink %output (string-append %output "/self")))))))
+ (symlink %output (string-append %output "/self"))
+ #t)))))
(d (package-derivation %store p)))
(guard (c ((nix-protocol-error? c) #t))
(build-derivations %store (list d))
@@ -766,7 +780,9 @@
(inherit p1r) (name "p1") (replacement p1r)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (mkdir (assoc-ref %outputs "out"))))))
+ #:builder (begin
+ (mkdir (assoc-ref %outputs "out"))
+ #t)))))
(p2r (dummy-package "P2"
(build-system trivial-build-system)
(inputs `(("p1" ,p1)))
@@ -786,7 +802,8 @@
(mkdir out)
(chdir out)
(symlink (assoc-ref %build-inputs "p1")
- "p1"))))))
+ "p1")
+ #t)))))
(p3 (dummy-package "p3"
(build-system trivial-build-system)
(inputs `(("p2" ,p2)))
@@ -796,7 +813,8 @@
(mkdir out)
(chdir out)
(symlink (assoc-ref %build-inputs "p2")
- "p2")))))))
+ "p2")
+ #t))))))
(lset= equal?
(package-grafts %store p3)
(list (graft
@@ -990,7 +1008,8 @@
(call-with-output-file
(string-append out "/xml/bar/baz/catalog.xml")
(lambda (port)
- (display "xml? wat?!" port)))))))
+ (display "xml? wat?!" port)))
+ #t))))
(synopsis #f) (description #f)
(home-page #f) (license #f)))
(p2 (package
@@ -1001,7 +1020,9 @@
(build-system trivial-build-system)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (mkdir (assoc-ref %outputs "out"))))
+ #:builder (begin
+ (mkdir (assoc-ref %outputs "out"))
+ #t)))
(native-search-paths (package-native-search-paths libxml2))
(synopsis #f) (description #f)
(home-page #f) (license #f)))
@@ -1043,7 +1064,9 @@
(build-system trivial-build-system)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (mkdir (assoc-ref %outputs "out"))))
+ #:builder (begin
+ (mkdir (assoc-ref %outputs "out"))
+ #t)))
(native-search-paths (package-native-search-paths git))))
(prof1 (run-with-store %store
(profile-derivation
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 92eb08cb9e..eba79d4e31 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -453,7 +453,8 @@
(mkdir (string-append out "/etc"))
(call-with-output-file (string-append out "/etc/foo")
(lambda (port)
- (display "foo!" port))))))))
+ (display "foo!" port)))
+ #t)))))
(entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry))
#:hooks '()
@@ -482,7 +483,8 @@
(symlink "foo" (string-append out "/etc"))
(call-with-output-file (string-append out "/etc/bar")
(lambda (port)
- (display "foo!" port))))))))
+ (display "foo!" port)))
+ #t)))))
(entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry))
#:hooks '()