;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix monads)
+ #:use-module (guix grafts)
#:use-module ((guix utils)
;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package.
#:use-module (guix hash)
#:use-module (guix derivations)
#:use-module (guix packages)
+ #:use-module (guix grafts)
+ #:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
(define %store
(open-connection-for-tests))
+;; Globally disable grafting to avoid rebuilding the world ('graft-derivation'
+;; can trigger builds early.)
+(%graft? #f)
+
\f
(test-begin "packages")
(test-assert "printer with location"
- (string-match "^#<package foo-0 foo.scm:42 [[:xdigit:]]+>$"
+ (string-match "^#<package foo@0 foo.scm:42 [[:xdigit:]]+>$"
(with-output-to-string
(lambda ()
(write
(location (make-location "foo.scm" 42 7))))))))
(test-assert "printer without location"
- (string-match "^#<package foo-0 [[:xdigit:]]+>$"
+ (string-match "^#<package foo@0 [[:xdigit:]]+>$"
(with-output-to-string
(lambda ()
(write
(equal? x (collect (package-derivation %store b)))
(equal? x (collect (package-derivation %store c)))))))
+(test-assert "package-transitive-native-search-paths"
+ (let* ((sp (lambda (name)
+ (list (search-path-specification
+ (variable name)
+ (files '("foo/bar"))))))
+ (p0 (dummy-package "p0" (native-search-paths (sp "PATH0"))))
+ (p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
+ (p2 (dummy-package "p2"
+ (native-search-paths (sp "PATH2"))
+ (inputs `(("p0" ,p0)))
+ (propagated-inputs `(("p1" ,p1)))))
+ (p3 (dummy-package "p3"
+ (native-search-paths (sp "PATH3"))
+ (native-inputs `(("p0" ,p0)))
+ (propagated-inputs `(("p2" ,p2))))))
+ (lset= string=?
+ '("PATH1" "PATH2" "PATH3")
+ (map search-path-specification-variable
+ (package-transitive-native-search-paths p3)))))
+
(test-assert "package-cross-derivation"
(let ((drv (package-cross-derivation %store (dummy-package "p")
"mips64el-linux-gnu")))
(package-cross-derivation %store p "mips64el-linux-gnu")
#f)))
-(test-equal "package-derivation, direct graft"
- (package-derivation %store gnu-make)
- (let ((p (package (inherit coreutils)
- (replacement gnu-make))))
- (package-derivation %store p)))
+;; XXX: The next two tests can trigger builds when the distro defines
+;; replacements on core packages, so they're disable for lack of a better
+;; solution.
-(test-equal "package-cross-derivation, direct graft"
- (package-cross-derivation %store gnu-make "mips64el-linux-gnu")
- (let ((p (package (inherit coreutils)
- (replacement gnu-make))))
- (package-cross-derivation %store p "mips64el-linux-gnu")))
+;; (test-equal "package-derivation, direct graft"
+;; (package-derivation %store gnu-make #:graft? #f)
+;; (let ((p (package (inherit coreutils)
+;; (replacement gnu-make))))
+;; (package-derivation %store p #:graft? #t)))
+
+;; (test-equal "package-cross-derivation, direct graft"
+;; (package-cross-derivation %store gnu-make "mips64el-linux-gnu"
+;; #:graft? #f)
+;; (let ((p (package (inherit coreutils)
+;; (replacement gnu-make))))
+;; (package-cross-derivation %store p "mips64el-linux-gnu"
+;; #:graft? #t)))
(test-assert "package-grafts, indirect grafts"
(let* ((new (dummy-package "dep"
(arguments '(#:implicit-inputs? #f))
(inputs `(("dep" ,dep*)))))
(target "mips64el-linux-gnu"))
- (equal? (package-grafts %store dummy #:target target)
- (list (graft
- (origin (package-cross-derivation %store dep target))
- (replacement
- (package-cross-derivation %store new target)))))))
+ ;; XXX: There might be additional grafts, for instance if the distro
+ ;; defines replacements for core packages like Perl.
+ (member (graft
+ (origin (package-cross-derivation %store dep target))
+ (replacement
+ (package-cross-derivation %store new target)))
+ (package-grafts %store dummy #:target target))))
(test-assert "package-grafts, indirect grafts, propagated inputs"
(let* ((new (dummy-package "dep"
(origin (package-derivation %store dep))
(replacement (package-derivation %store new)))))))
-(test-assert "package-derivation, indirect grafts"
- (let* ((new (dummy-package "dep"
- (arguments '(#:implicit-inputs? #f))))
- (dep (package (inherit new) (version "0.0")))
- (dep* (package (inherit dep) (replacement new)))
- (dummy (dummy-package "dummy"
- (arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep*)))))
- (guile (package-derivation %store (canonical-package guile-2.0)
- #:graft? #f)))
- (equal? (package-derivation %store dummy)
- (graft-derivation %store "dummy-0"
- (package-derivation %store dummy #:graft? #f)
- (package-grafts %store dummy)
+(test-assert "package-grafts, same replacement twice"
+ (let* ((new (dummy-package "dep"
+ (version "1")
+ (arguments '(#:implicit-inputs? #f))))
+ (dep (package (inherit new) (version "0") (replacement new)))
+ (p1 (dummy-package "intermediate1"
+ (arguments '(#:implicit-inputs? #f))
+ (inputs `(("dep" ,dep)))))
+ (p2 (dummy-package "intermediate2"
+ (arguments '(#:implicit-inputs? #f))
+ ;; Here we copy DEP to have an equivalent package that is not
+ ;; 'eq?' to DEP. This is similar to what happens with
+ ;; 'package-with-explicit-inputs' & co.
+ (inputs `(("dep" ,(package (inherit dep)))))))
+ (p3 (dummy-package "final"
+ (arguments '(#:implicit-inputs? #f))
+ (inputs `(("p1" ,p1) ("p2" ,p2))))))
+ (equal? (package-grafts %store p3)
+ (list (graft
+ (origin (package-derivation %store
+ (package (inherit dep)
+ (replacement #f))))
+ (replacement (package-derivation %store new)))))))
- ;; Use the same Guile as 'package-derivation'.
- #:guile guile))))
+;;; XXX: Nowadays 'graft-derivation' needs to build derivations beforehand to
+;;; find out about their run-time dependencies, so this test is no longer
+;;; applicable since it would trigger a full rebuild.
+;;
+;; (test-assert "package-derivation, indirect grafts"
+;; (let* ((new (dummy-package "dep"
+;; (arguments '(#:implicit-inputs? #f))))
+;; (dep (package (inherit new) (version "0.0")))
+;; (dep* (package (inherit dep) (replacement new)))
+;; (dummy (dummy-package "dummy"
+;; (arguments '(#:implicit-inputs? #f))
+;; (inputs `(("dep" ,dep*)))))
+;; (guile (package-derivation %store (canonical-package guile-2.0)
+;; #:graft? #f)))
+;; (equal? (package-derivation %store dummy)
+;; (graft-derivation %store
+;; (package-derivation %store dummy #:graft? #f)
+;; (package-grafts %store dummy)
+
+;; ;; Use the same Guile as 'package-derivation'.
+;; #:guile guile))))
(test-equal "package->bag"
`("foo86-hurd" #f (,(package-source gnu-make))
(guix-package "-p" (derivation->output-path prof)
"--search-paths"))))))
+(test-equal "specification->package when not found"
+ 'quit
+ (catch 'quit
+ (lambda ()
+ ;; This should call 'leave', producing an error message.
+ (specification->package "this-package-does-not-exist"))
+ (lambda (key . args)
+ key)))
+
(test-end "packages")
\f
HCoop / jackhill / guix / guix.git / blobdiff