tests: Disable grafting by default for most tests.
This allows tests to run as expected even in the presence of
replacements among the bootstrap packages, such as Perl (commit
d8173f21f7
).
* tests/cpan.scm: Add (%graft? #f).
* tests/derivations.scm: Likewise.
* tests/graph.scm: Likewise.
* tests/monads.scm: Likewise.
* tests/profiles.scm: Likewise.
* tests/gexp.scm: Likewise.
("gexp->derivation vs. grafts"): Explicitly reenable grafting before,
and disable it after, using 'set-grafting'.
master
parent
322bb53c7a
commit
ef8de9852e
|
@ -21,9 +21,13 @@
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (guix hash)
|
#:use-module (guix hash)
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
|
#:use-module (guix grafts)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
|
(%graft? #f)
|
||||||
|
|
||||||
(define test-json
|
(define test-json
|
||||||
"{
|
"{
|
||||||
\"metadata\" : {
|
\"metadata\" : {
|
||||||
|
@ -44,7 +48,7 @@
|
||||||
],
|
],
|
||||||
\"abstract\" : \"Fizzle Fuzz\",
|
\"abstract\" : \"Fizzle Fuzz\",
|
||||||
\"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
|
\"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
|
||||||
\"author\" : \"GUIX\",
|
\"author\" : \"Guix\",
|
||||||
\"version\" : \"0.1\"
|
\"version\" : \"0.1\"
|
||||||
}")
|
}")
|
||||||
|
|
||||||
|
|
|
@ -18,6 +18,7 @@
|
||||||
|
|
||||||
(define-module (test-derivations)
|
(define-module (test-derivations)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix hash)
|
#:use-module (guix hash)
|
||||||
|
@ -44,6 +45,9 @@
|
||||||
(define %store
|
(define %store
|
||||||
(open-connection-for-tests))
|
(open-connection-for-tests))
|
||||||
|
|
||||||
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
|
(%graft? #f)
|
||||||
|
|
||||||
(define (bootstrap-binary name)
|
(define (bootstrap-binary name)
|
||||||
(let ((bin (search-bootstrap-binary name (%current-system))))
|
(let ((bin (search-bootstrap-binary name (%current-system))))
|
||||||
(and %store
|
(and %store
|
||||||
|
@ -71,6 +75,7 @@
|
||||||
(lambda (e1 e2)
|
(lambda (e1 e2)
|
||||||
(string<? (car e1) (car e2)))))
|
(string<? (car e1) (car e2)))))
|
||||||
|
|
||||||
|
|
||||||
(test-begin "derivations")
|
(test-begin "derivations")
|
||||||
|
|
||||||
(test-assert "parse & export"
|
(test-assert "parse & export"
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
|
@ -39,6 +40,9 @@
|
||||||
(define %store
|
(define %store
|
||||||
(open-connection-for-tests))
|
(open-connection-for-tests))
|
||||||
|
|
||||||
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
|
(%graft? #f)
|
||||||
|
|
||||||
;; For white-box testing.
|
;; For white-box testing.
|
||||||
(define (gexp-inputs x)
|
(define (gexp-inputs x)
|
||||||
((@@ (guix gexp) gexp-inputs) x))
|
((@@ (guix gexp) gexp-inputs) x))
|
||||||
|
@ -334,7 +338,8 @@
|
||||||
(equal? refs2 (list file))))))
|
(equal? refs2 (list file))))))
|
||||||
|
|
||||||
(test-assertm "gexp->derivation vs. grafts"
|
(test-assertm "gexp->derivation vs. grafts"
|
||||||
(mlet* %store-monad ((p0 -> (dummy-package "dummy"
|
(mlet* %store-monad ((graft? (set-grafting #f))
|
||||||
|
(p0 -> (dummy-package "dummy"
|
||||||
(arguments
|
(arguments
|
||||||
'(#:implicit-inputs? #f))))
|
'(#:implicit-inputs? #f))))
|
||||||
(r -> (package (inherit p0) (name "DuMMY")))
|
(r -> (package (inherit p0) (name "DuMMY")))
|
||||||
|
@ -342,9 +347,10 @@
|
||||||
(exp0 -> (gexp (frob (ungexp p0) (ungexp output))))
|
(exp0 -> (gexp (frob (ungexp p0) (ungexp output))))
|
||||||
(exp1 -> (gexp (frob (ungexp p1) (ungexp output))))
|
(exp1 -> (gexp (frob (ungexp p1) (ungexp output))))
|
||||||
(void (set-guile-for-build %bootstrap-guile))
|
(void (set-guile-for-build %bootstrap-guile))
|
||||||
(drv0 (gexp->derivation "t" exp0))
|
(drv0 (gexp->derivation "t" exp0 #:graft? #t))
|
||||||
(drv1 (gexp->derivation "t" exp1))
|
(drv1 (gexp->derivation "t" exp1 #:graft? #t))
|
||||||
(drv1* (gexp->derivation "t" exp1 #:graft? #f)))
|
(drv1* (gexp->derivation "t" exp1 #:graft? #f))
|
||||||
|
(_ (set-grafting graft?)))
|
||||||
(return (and (not (string=? (derivation->output-path drv0)
|
(return (and (not (string=? (derivation->output-path drv0)
|
||||||
(derivation->output-path drv1)))
|
(derivation->output-path drv1)))
|
||||||
(string=? (derivation->output-path drv0)
|
(string=? (derivation->output-path drv0)
|
||||||
|
|
|
@ -24,6 +24,7 @@
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (guix build-system trivial)
|
#:use-module (guix build-system trivial)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
@ -41,6 +42,9 @@
|
||||||
(define %store
|
(define %store
|
||||||
(open-connection-for-tests))
|
(open-connection-for-tests))
|
||||||
|
|
||||||
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
|
(%graft? #f)
|
||||||
|
|
||||||
(define (make-recording-backend)
|
(define (make-recording-backend)
|
||||||
"Return a <graph-backend> and a thunk that returns the recorded nodes and
|
"Return a <graph-backend> and a thunk that returns the recorded nodes and
|
||||||
edges."
|
edges."
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
|
@ -36,6 +37,9 @@
|
||||||
(define %store
|
(define %store
|
||||||
(open-connection-for-tests))
|
(open-connection-for-tests))
|
||||||
|
|
||||||
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
|
(%graft? #f)
|
||||||
|
|
||||||
(define %monads
|
(define %monads
|
||||||
(list %identity-monad %store-monad %state-monad))
|
(list %identity-monad %store-monad %state-monad))
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -22,6 +22,7 @@
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix build-system trivial)
|
#:use-module (guix build-system trivial)
|
||||||
|
@ -41,6 +42,9 @@
|
||||||
(define %store
|
(define %store
|
||||||
(open-connection-for-tests))
|
(open-connection-for-tests))
|
||||||
|
|
||||||
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
|
(%graft? #f)
|
||||||
|
|
||||||
(define-syntax-rule (test-assertm name exp)
|
(define-syntax-rule (test-assertm name exp)
|
||||||
(test-assert name
|
(test-assert name
|
||||||
(run-with-store %store exp
|
(run-with-store %store exp
|
||||||
|
|
Reference in New Issue