summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-12-06 09:07:28 +0100
committerLudovic Courtès <ludo@gnu.org>2017-12-06 09:07:28 +0100
commit609d126e86ea7a05ab7e758fa3fd000ced005f49 (patch)
tree9bc27e832508ae30cb75016d2d1ad789ce988c15
parentf0eb57b736f6fae67acbaad66a1b5e18fdfc10a0 (diff)
Revert "packages: 'package-grafts' trims native inputs."
This reverts commit 91c9b5d016ac8bed127557d378c70fbc56cec0e5 following the concerns raised by Mark, Ben, and Tobias: <https://lists.gnu.org/archive/html/guix-devel/2017-12/msg00081.html>.
-rw-r--r--guix/packages.scm53
-rw-r--r--tests/packages.scm18
2 files changed, 22 insertions, 49 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 490ec869063..c6d3b811f21 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1004,21 +1004,7 @@ dependencies; otherwise, restrict to target dependencies."
1004 (if (bag-target bag) 1004 (if (bag-target bag)
1005 '() 1005 '()
1006 (bag-host-inputs bag)))) 1006 (bag-host-inputs bag))))
1007 (lambda (bag) 1007 bag-host-inputs))
1008 (if (bag-target bag)
1009 (bag-host-inputs bag)
1010
1011 ;; XXX: Currently libc wrongfully ends up in 'build-inputs',
1012 ;; even tough it's something that's still referenced at run time
1013 ;; and thus conceptually a 'host-inputs'. Because of that, we
1014 ;; re-add it here.
1015 (if (assoc-ref (bag-host-inputs bag) "libc")
1016 (bag-host-inputs bag)
1017 (append (let ((libc (assoc-ref (bag-build-inputs bag)
1018 "libc")))
1019 (or (and libc `(("libc" ,@libc)))
1020 '()))
1021 (bag-host-inputs bag)))))))
1022 1008
1023 (define nodes 1009 (define nodes
1024 (match (bag-direct-inputs* bag) 1010 (match (bag-direct-inputs* bag)
@@ -1052,28 +1038,33 @@ to (see 'graft-derivation'.)"
1052 (define system (bag-system bag)) 1038 (define system (bag-system bag))
1053 (define target (bag-target bag)) 1039 (define target (bag-target bag))
1054 1040
1055 (define (grafts package->graft) 1041 (define native-grafts
1056 (fold-bag-dependencies (lambda (package grafts) 1042 (let ((->graft (input-graft store system)))
1057 (match (package->graft package) 1043 (fold-bag-dependencies (lambda (package grafts)
1058 (#f grafts) 1044 (match (->graft package)
1059 (graft (cons graft grafts)))) 1045 (#f grafts)
1060 '() 1046 (graft (cons graft grafts))))
1061 bag 1047 '()
1062 1048 bag)))
1063 ;; Grafts that apply to native inputs do not matter 1049
1064 ;; since, by definition, native inputs are not 1050 (define target-grafts
1065 ;; referred to at run time. Thus, ignore 1051 (if target
1066 ;; 'native-inputs' and focus on the others. 1052 (let ((->graft (input-cross-graft store target system)))
1067 #:native? #f)) 1053 (fold-bag-dependencies (lambda (package grafts)
1054 (match (->graft package)
1055 (#f grafts)
1056 (graft (cons graft grafts))))
1057 '()
1058 bag
1059 #:native? #f))
1060 '()))
1068 1061
1069 ;; We can end up with several identical grafts if we stumble upon packages 1062 ;; We can end up with several identical grafts if we stumble upon packages
1070 ;; that are not 'eq?' but map to the same derivation (this can happen when 1063 ;; that are not 'eq?' but map to the same derivation (this can happen when
1071 ;; using things like 'package-with-explicit-inputs'.) Hence the 1064 ;; using things like 'package-with-explicit-inputs'.) Hence the
1072 ;; 'delete-duplicates' call. 1065 ;; 'delete-duplicates' call.
1073 (delete-duplicates 1066 (delete-duplicates
1074 (if target 1067 (append native-grafts target-grafts)))
1075 (grafts (input-cross-graft store target system))
1076 (grafts (input-graft store system)))))
1077 1068
1078(define* (package-grafts store package 1069(define* (package-grafts store package
1079 #:optional (system (%current-system)) 1070 #:optional (system (%current-system))
diff --git a/tests/packages.scm b/tests/packages.scm
index fe7bd1ded69..930374dabfa 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -660,24 +660,6 @@
660;; (package-cross-derivation %store p "mips64el-linux-gnu" 660;; (package-cross-derivation %store p "mips64el-linux-gnu"
661;; #:graft? #t))) 661;; #:graft? #t)))
662 662
663;; It doesn't make sense for 'package-grafts' to look at native inputs since,
664;; by definition, they are not referenced at run time. Make sure
665;; 'package-grafts' respects this.
666(test-equal "package-grafts, grafts of native inputs ignored"
667 '()
668 (let* ((new (dummy-package "native-dep"
669 (version "0.1")
670 (arguments '(#:implicit-inputs? #f))))
671 (ndep (package (inherit new) (version "0.0")
672 (replacement new)))
673 (dep (dummy-package "dep"
674 (arguments '(#:implicit-inputs? #f))))
675 (dummy (dummy-package "dummy"
676 (arguments '(#:implicit-inputs? #f))
677 (native-inputs `(("ndep" ,ndep)))
678 (inputs `(("dep" ,dep))))))
679 (package-grafts %store dummy)))
680
681(test-assert "package-grafts, indirect grafts" 663(test-assert "package-grafts, indirect grafts"
682 (let* ((new (dummy-package "dep" 664 (let* ((new (dummy-package "dep"
683 (arguments '(#:implicit-inputs? #f)))) 665 (arguments '(#:implicit-inputs? #f))))