~ruther/guix-local

ef8de9852eeb9f9ce8e01a2a4f60a057b890b94a — Ludovic Courtès 10 years ago 322bb53
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'.
6 files changed, 35 insertions(+), 8 deletions(-)

M tests/cpan.scm
M tests/derivations.scm
M tests/gexp.scm
M tests/graph.scm
M tests/monads.scm
M tests/profiles.scm
M tests/cpan.scm => tests/cpan.scm +5 -1
@@ 21,9 21,13 @@
  #: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\"
}")


M tests/derivations.scm => tests/derivations.scm +5 -0
@@ 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)))))


(test-begin "derivations")

(test-assert "parse & export"

M tests/gexp.scm => tests/gexp.scm +11 -5
@@ 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))


@@ 334,7 338,8 @@
                 (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 @@
                       (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)

M tests/graph.scm => tests/graph.scm +4 -0
@@ 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."

M tests/monads.scm => tests/monads.scm +5 -1
@@ 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))


M tests/profiles.scm => tests/profiles.scm +5 -1
@@ 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