tests: Disable grafting by default for most tests.
authorLudovic Courtès <ludo@gnu.org>
Sun, 6 Mar 2016 20:53:28 +0000 (21:53 +0100)
committerLudovic Courtès <ludo@gnu.org>
Sun, 6 Mar 2016 22:16:35 +0000 (23:16 +0100)
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
tests/derivations.scm
tests/gexp.scm
tests/graph.scm
tests/monads.scm
tests/profiles.scm

index 2f95135..5836841 100644 (file)
   #: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 @@
   ],
   \"abstract\" : \"Fizzle Fuzz\",
   \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
-  \"author\" : \"GUIX\",
+  \"author\" : \"Guix\",
   \"version\" : \"0.1\"
 }")
 
index 9b53019..3c35218 100644 (file)
@@ -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 %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 @@
         (lambda (e1 e2)
           (string<? (car e1) (car e2)))))
 
+\f
 (test-begin "derivations")
 
 (test-assert "parse & export"
index 87c7747..d343dc3 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -20,6 +20,7 @@
   #: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 %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))
                  (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")))
                        (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)
index 43f7b73..4205b9b 100644 (file)
@@ -24,6 +24,7 @@
   #: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 %store
   (open-connection-for-tests))
 
+;; Globally disable grafts because they can trigger early builds.
+(%graft? #f)
+
 (define (make-recording-backend)
   "Return a <graph-backend> and a thunk that returns the recorded nodes and
 edges."
index 62a07a2..4112bcb 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -20,6 +20,7 @@
   #: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 %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))
 
index e659c2e..6714dfc 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -22,6 +22,7 @@
   #: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 %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