From 1e868858fd2de0d1125e6191be5e28df22fe6665 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 27 Mar 2018 20:05:58 -0400 Subject: [PATCH] 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. --- tests/packages.scm | 77 ++++++++++++++++++++++++++++++---------------- tests/profiles.scm | 6 ++-- 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 '()