me
/
guix
Archived
1
0
Fork 0

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
Ludovic Courtès 2016-03-06 21:53:28 +01:00
parent 322bb53c7a
commit ef8de9852e
6 changed files with 35 additions and 8 deletions

View File

@ -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\"
}") }")

View File

@ -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"

View File

@ -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)

View File

@ -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."

View File

@ -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))

View File

@ -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