nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Mark H Weaver 2018-03-27 20:05:58 -04:00
parent e3cfef22c4
commit 1e868858fd
No known key found for this signature in database
GPG Key ID: 7CEF29847562C516
2 changed files with 54 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
tests/packages.scm
View File

@ -407,18 +407,23 @@
(%current-system))))) (%current-system)))))
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
#:builder #:builder
(begin
(use-modules (guix build utils))
(let ((tar (assoc-ref %build-inputs "tar")) (let ((tar (assoc-ref %build-inputs "tar"))
(xz (assoc-ref %build-inputs "xz")) (xz (assoc-ref %build-inputs "xz"))
(source (assoc-ref %build-inputs "source"))) (source (assoc-ref %build-inputs "source")))
(and (zero? (system* tar "xvf" source (invoke tar "xvf" source
"--use-compress-program" xz)) "--use-compress-program" xz)
(string=? "guile" (readlink "bin/guile-rocks")) (unless (and (string=? "guile" (readlink "bin/guile-rocks"))
(file-exists? "bin/scripts/compile.scm") (file-exists? "bin/scripts/compile.scm"))
(error "the snippet apparently failed"))
(let ((out (assoc-ref %outputs "out"))) (let ((out (assoc-ref %outputs "out")))
(call-with-output-file out (call-with-output-file out
(lambda (p) (lambda (p)
(display "OK" p)))))))))) (display "OK" p))))
#t))))))
(drv (package-derivation %store package)) (drv (package-derivation %store package))
(out (derivation->output-path drv))) (out (derivation->output-path drv)))
(and (build-derivations %store (list (pk 'snippet-drv drv))) (and (build-derivations %store (list (pk 'snippet-drv drv)))
@ -486,7 +491,8 @@
(mkdir %output) (mkdir %output)
(call-with-output-file (string-append %output "/test") (call-with-output-file (string-append %output "/test")
(lambda (p) (lambda (p)
(display '(hello guix) p)))))))) (display '(hello guix) p)))
#t)))))
(d (package-derivation %store p))) (d (package-derivation %store p)))
(and (build-derivations %store (list d)) (and (build-derivations %store (list d))
(let ((p (pk 'drv d (derivation->output-path d)))) (let ((p (pk 'drv d (derivation->output-path d))))
@ -500,8 +506,10 @@
(source #f) (source #f)
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:builder (copy-file (assoc-ref %build-inputs "input") #:builder (begin
%output))) (copy-file (assoc-ref %build-inputs "input")
%output)
#t)))
(inputs `(("input" ,i))))) (inputs `(("input" ,i)))))
(d (package-derivation %store p))) (d (package-derivation %store p)))
(and (build-derivations %store (list d)) (and (build-derivations %store (list d))
@ -516,8 +524,10 @@
(source i) (source i)
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:builder (copy-file (assoc-ref %build-inputs "source") #:builder (begin
%output))))) (copy-file (assoc-ref %build-inputs "source")
%output)
#t)))))
(d (package-derivation %store p))) (d (package-derivation %store p)))
(and (build-derivations %store (list d)) (and (build-derivations %store (list d))
(let ((p (derivation->output-path d))) (let ((p (derivation->output-path d)))
@ -530,10 +540,13 @@
(source #f) (source #f)
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
#:builder #:builder
(begin
(use-modules (guix build utils))
(let ((out (assoc-ref %outputs "out")) (let ((out (assoc-ref %outputs "out"))
(bash (assoc-ref %build-inputs "bash"))) (bash (assoc-ref %build-inputs "bash")))
(zero? (system* bash "-c" (invoke bash "-c"
(format #f "echo hello > ~a" out)))))) (format #f "echo hello > ~a" out))))))
(inputs `(("bash" ,(search-bootstrap-binary "bash" (inputs `(("bash" ,(search-bootstrap-binary "bash"
(%current-system))))))) (%current-system)))))))
@ -554,7 +567,8 @@
(mkdir %output) (mkdir %output)
;; The reference to itself isn't allowed so building it ;; The reference to itself isn't allowed so building it
;; should fail. ;; should fail.
(symlink %output (string-append %output "/self"))))))) (symlink %output (string-append %output "/self"))
#t)))))
(d (package-derivation %store p))) (d (package-derivation %store p)))
(guard (c ((nix-protocol-error? c) #t)) (guard (c ((nix-protocol-error? c) #t))
(build-derivations %store (list d)) (build-derivations %store (list d))
@ -766,7 +780,9 @@
(inherit p1r) (name "p1") (replacement p1r) (inherit p1r) (name "p1") (replacement p1r)
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:builder (mkdir (assoc-ref %outputs "out")))))) #:builder (begin
(mkdir (assoc-ref %outputs "out"))
#t)))))
(p2r (dummy-package "P2" (p2r (dummy-package "P2"
(build-system trivial-build-system) (build-system trivial-build-system)
(inputs `(("p1" ,p1))) (inputs `(("p1" ,p1)))
@ -786,7 +802,8 @@
(mkdir out) (mkdir out)
(chdir out) (chdir out)
(symlink (assoc-ref %build-inputs "p1") (symlink (assoc-ref %build-inputs "p1")
"p1")))))) "p1")
#t)))))
(p3 (dummy-package "p3" (p3 (dummy-package "p3"
(build-system trivial-build-system) (build-system trivial-build-system)
(inputs `(("p2" ,p2))) (inputs `(("p2" ,p2)))
@ -796,7 +813,8 @@
(mkdir out) (mkdir out)
(chdir out) (chdir out)
(symlink (assoc-ref %build-inputs "p2") (symlink (assoc-ref %build-inputs "p2")
"p2"))))))) "p2")
#t))))))
(lset= equal? (lset= equal?
(package-grafts %store p3) (package-grafts %store p3)
(list (graft (list (graft
@ -990,7 +1008,8 @@
(call-with-output-file (call-with-output-file
(string-append out "/xml/bar/baz/catalog.xml") (string-append out "/xml/bar/baz/catalog.xml")
(lambda (port) (lambda (port)
(display "xml? wat?!" port))))))) (display "xml? wat?!" port)))
#t))))
(synopsis #f) (description #f) (synopsis #f) (description #f)
(home-page #f) (license #f))) (home-page #f) (license #f)))
(p2 (package (p2 (package
@ -1001,7 +1020,9 @@
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#: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)) (native-search-paths (package-native-search-paths libxml2))
(synopsis #f) (description #f) (synopsis #f) (description #f)
(home-page #f) (license #f))) (home-page #f) (license #f)))
@ -1043,7 +1064,9 @@
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#: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)))) (native-search-paths (package-native-search-paths git))))
(prof1 (run-with-store %store (prof1 (run-with-store %store
(profile-derivation (profile-derivation

6
tests/profiles.scm
View File

@ -453,7 +453,8 @@
(mkdir (string-append out "/etc")) (mkdir (string-append out "/etc"))
(call-with-output-file (string-append out "/etc/foo") (call-with-output-file (string-append out "/etc/foo")
(lambda (port) (lambda (port)
(display "foo!" port)))))))) (display "foo!" port)))
#t)))))
(entry -> (package->manifest-entry thing)) (entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry)) (drv (profile-derivation (manifest (list entry))
#:hooks '() #:hooks '()
@ -482,7 +483,8 @@
(symlink "foo" (string-append out "/etc")) (symlink "foo" (string-append out "/etc"))
(call-with-output-file (string-append out "/etc/bar") (call-with-output-file (string-append out "/etc/bar")
(lambda (port) (lambda (port)
(display "foo!" port)))))))) (display "foo!" port)))
#t)))))
(entry -> (package->manifest-entry thing)) (entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry)) (drv (profile-derivation (manifest (list entry))
#:hooks '() #:hooks '()