From ef8de9852eeb9f9ce8e01a2a4f60a057b890b94a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 6 Mar 2016 21:53:28 +0100 Subject: 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 d8173f21f7b4e3cb83541b8fa70621d2b6d4ce1c). * 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'. --- tests/cpan.scm | 6 +++++- tests/derivations.scm | 5 +++++ tests/gexp.scm | 16 +++++++++++----- tests/graph.scm | 4 ++++ tests/monads.scm | 6 +++++- tests/profiles.scm | 6 +++++- 6 files changed, 35 insertions(+), 8 deletions(-) diff --git a/tests/cpan.scm b/tests/cpan.scm index 2f9513519e..583684104d 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -21,9 +21,13 @@ (define-module (test-cpan) #:use-module (guix base32) #:use-module (guix hash) #:use-module (guix tests) + #:use-module (guix grafts) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + (define test-json "{ \"metadata\" : { @@ -44,7 +48,7 @@ (define test-json ], \"abstract\" : \"Fizzle Fuzz\", \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\", - \"author\" : \"GUIX\", + \"author\" : \"Guix\", \"version\" : \"0.1\" }") diff --git a/tests/derivations.scm b/tests/derivations.scm index 9b53019cc5..3c35218040 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -18,6 +18,7 @@ (define-module (test-derivations) #:use-module (guix derivations) + #:use-module (guix grafts) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix hash) @@ -44,6 +45,9 @@ (define-module (test-derivations) (define %store (open-connection-for-tests)) +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + (define (bootstrap-binary name) (let ((bin (search-bootstrap-binary name (%current-system)))) (and %store @@ -71,6 +75,7 @@ (define prefix-len (string-length dir)) (lambda (e1 e2) (string +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ (define-module (test-gexp) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix gexp) + #:use-module (guix grafts) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix tests) @@ -39,6 +40,9 @@ (define-module (test-gexp) (define %store (open-connection-for-tests)) +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + ;; For white-box testing. (define (gexp-inputs x) ((@@ (guix gexp) gexp-inputs) x)) @@ -334,7 +338,8 @@ (define (match-input thing) (equal? refs2 (list file)))))) (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 '(#:implicit-inputs? #f)))) (r -> (package (inherit p0) (name "DuMMY"))) @@ -342,9 +347,10 @@ (define (match-input thing) (exp0 -> (gexp (frob (ungexp p0) (ungexp output)))) (exp1 -> (gexp (frob (ungexp p1) (ungexp output)))) (void (set-guile-for-build %bootstrap-guile)) - (drv0 (gexp->derivation "t" exp0)) - (drv1 (gexp->derivation "t" exp1)) - (drv1* (gexp->derivation "t" exp1 #:graft? #f))) + (drv0 (gexp->derivation "t" exp0 #:graft? #t)) + (drv1 (gexp->derivation "t" exp1 #:graft? #t)) + (drv1* (gexp->derivation "t" exp1 #:graft? #f)) + (_ (set-grafting graft?))) (return (and (not (string=? (derivation->output-path drv0) (derivation->output-path drv1))) (string=? (derivation->output-path drv0) diff --git a/tests/graph.scm b/tests/graph.scm index 43f7b733f9..4205b9b8c7 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -24,6 +24,7 @@ (define-module (test-graph) #:use-module (guix derivations) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix grafts) #:use-module (guix build-system gnu) #:use-module (guix build-system trivial) #:use-module (guix gexp) @@ -41,6 +42,9 @@ (define-module (test-graph) (define %store (open-connection-for-tests)) +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + (define (make-recording-backend) "Return a and a thunk that returns the recorded nodes and edges." diff --git a/tests/monads.scm b/tests/monads.scm index 62a07a2bc6..4112bcb6cf 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ (define-module (test-monads) #:use-module (guix tests) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix grafts) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (gnu packages) @@ -36,6 +37,9 @@ (define-module (test-monads) (define %store (open-connection-for-tests)) +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + (define %monads (list %identity-monad %store-monad %state-monad)) diff --git a/tests/profiles.scm b/tests/profiles.scm index e659c2e26d..6714dfcaa7 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2014 Alex Kost ;;; ;;; This file is part of GNU Guix. @@ -22,6 +22,7 @@ (define-module (test-profiles) #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix build-system trivial) @@ -41,6 +42,9 @@ (define-module (test-profiles) (define %store (open-connection-for-tests)) +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + (define-syntax-rule (test-assertm name exp) (test-assert name (run-with-store %store exp -- cgit v1.2.3