From 8524349f78c37439698f29d43049c2b21df6370f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 20 May 2021 15:46:08 +0200 Subject: [PATCH] packages: Allow inputs to be plain package lists. * guix/packages.scm (add-input-label, sanitize-inputs): New procedures. ()[inputs, propagated-inputs, native-inputs]: Add 'sanitize' property. * doc/guix.texi (Defining Packages, package Reference): (Defining Package Variants): Adjust examples accordingly. * tests/packages.scm ("transaction-upgrade-entry, zero upgrades, propagated inputs") ("transaction-upgrade-entry, grafts") ("package-transitive-inputs") ("package-transitive-supported-systems") ("package-closure") ("supported-package?") ("package-derivation, inputs deduplicated") ("package-transitive-native-search-paths") ("package-grafts, indirect grafts") ("package-grafts, indirect grafts, propagated inputs") ("package-grafts, same replacement twice") ("package-grafts, dependency on several outputs") ("replacement also grafted") ("package->bag, sensitivity to %current-target-system") ("package->bag, propagated inputs") ("package->bag, sensitivity to %current-system") ("package-input-rewriting/spec, identity") ("package-input-rewriting, identity"): Use the label-less input style. --- doc/guix.texi | 48 ++++++++++++++++++-------- guix/packages.scm | 35 +++++++++++++++++-- tests/packages.scm | 86 ++++++++++++++++++++++------------------------ 3 files changed, 108 insertions(+), 61 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 808b2af664..da00d1e429 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6476,7 +6476,7 @@ package looks like this: "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--enable-silent-rules"))) - (inputs `(("gawk" ,gawk))) + (inputs (list gawk)) (synopsis "Hello, GNU world: An example GNU package") (description "Guess what GNU Hello prints!") (home-page "https://www.gnu.org/software/hello/") @@ -6564,8 +6564,8 @@ Reference Manual}). @item The @code{inputs} field specifies inputs to the build process---i.e., -build-time or run-time dependencies of the package. Here, we define an -input called @code{"gawk"} whose value is that of the @code{gawk} +build-time or run-time dependencies of the package. Here, we add +an input, a reference to the @code{gawk} variable; @code{gawk} is itself bound to a @code{} object. @cindex backquote (quasiquote) @@ -6690,20 +6690,41 @@ list, typically containing sequential keyword-value pairs. @itemx @code{native-inputs} (default: @code{'()}) @itemx @code{propagated-inputs} (default: @code{'()}) @cindex inputs, of packages -These fields list dependencies of the package. Each one is a list of -tuples, where each tuple has a label for the input (a string) as its -first element, a package, origin, or derivation as its second element, -and optionally the name of the output thereof that should be used, which -defaults to @code{"out"} (@pxref{Packages with Multiple Outputs}, for -more on package outputs). For example, the list below specifies three -inputs: +These fields list dependencies of the package. Each element of these +lists is either a package, origin, or other ``file-like object'' +(@pxref{G-Expressions}); to specify the output of that file-like object +that should be used, pass a two-element list where the second element is +the output (@pxref{Packages with Multiple Outputs}, for more on package +outputs). For example, the list below specifies three inputs: @lisp +(list libffi libunistring + `(,glib "bin")) ;the "bin" output of GLib +@end lisp + +In the example above, the @code{"out"} output of @code{libffi} and +@code{libunistring} is used. + +@quotation Compatibility Note +Until version 1.3.0, input lists were a list of tuples, +where each tuple has a label for the input (a string) as its +first element, a package, origin, or derivation as its second element, +and optionally the name of the output thereof that should be used, which +defaults to @code{"out"}. For example, the list below is equivalent to +the one above, but using the @dfn{old input style}: + +@lisp +;; Old input style (deprecated). `(("libffi" ,libffi) ("libunistring" ,libunistring) - ("glib:bin" ,glib "bin")) ;the "bin" output of Glib + ("glib:bin" ,glib "bin")) ;the "bin" output of GLib @end lisp +This style is now deprecated; it is still supported but support will be +removed in a future version. It should not be used for new package +definitions. +@end quotation + @cindex cross compilation, package dependencies The distinction between @code{native-inputs} and @code{inputs} is necessary when considering cross-compilation. When cross-compiling, @@ -6789,7 +6810,7 @@ cross-compiling: ;; When cross-compiled, Guile, for example, depends on ;; a native version of itself. Add it here. (native-inputs (if (%current-target-system) - `(("self" ,this-package)) + (list this-package) '()))) @end lisp @@ -7105,8 +7126,7 @@ depends on it: (name name) (version "3.0") ;; several fields omitted - (inputs - `(("lua" ,lua))) + (inputs (list lua)) (synopsis "Socket library for Lua"))) (define-public lua5.1-socket diff --git a/guix/packages.scm b/guix/packages.scm index 3ba61b42c9..37814c2f63 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -366,6 +366,14 @@ (define %cuirass-supported-systems ;; . (fold delete %supported-systems '("mips64el-linux" "powerpc-linux"))) +(define-inlinable (sanitize-inputs inputs) + "Sanitize INPUTS by turning it into a list of name/package tuples if it's +not already the case." + (cond ((null? inputs) inputs) + ((and (pair? (car inputs)) + (string? (caar inputs))) + inputs) + (else (map add-input-label inputs)))) ;; A package. (define-record-type* @@ -380,11 +388,14 @@ (define-record-type* (default '()) (thunked)) (inputs package-inputs ; input packages or derivations - (default '()) (thunked)) + (default '()) (thunked) + (sanitize sanitize-inputs)) (propagated-inputs package-propagated-inputs ; same, but propagated - (default '()) (thunked)) + (default '()) (thunked) + (sanitize sanitize-inputs)) (native-inputs package-native-inputs ; native input packages/derivations - (default '()) (thunked)) + (default '()) (thunked) + (sanitize sanitize-inputs)) (outputs package-outputs ; list of strings (default '("out"))) @@ -415,6 +426,24 @@ (define-record-type* source-properties->location)) (innate))) +(define (add-input-label input) + "Add an input label to INPUT." + (match input + ((? package? package) + (list (package-name package) package)) + (((? package? package) output) ;XXX: ugly? + (list (package-name package) package output)) + ((? gexp-input?) ;XXX: misplaced because 'native?' field is ignored? + (let ((obj (gexp-input-thing input)) + (output (gexp-input-output input))) + `(,(if (package? obj) + (package-name obj) + "_") + ,obj + ,@(if (string=? output "out") '() (list output))))) + (x + `("_" ,x)))) + (set-record-type-printer! (lambda (package port) (let ((loc (package-location package)) diff --git a/tests/packages.scm b/tests/packages.scm index 47fc34d3ce..9ec4dd1928 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -137,7 +137,7 @@ (define %store ;; inputs. See . (let* ((dep (dummy-package "dep" (version "2"))) (old (dummy-package "foo" (version "1") - (propagated-inputs `(("dep" ,dep))))) + (propagated-inputs (list dep)))) (drv (package-derivation %store old)) (tx (mock ((gnu packages) find-best-packages-by-name (const (list old))) @@ -225,7 +225,7 @@ (define %store (bar (dummy-package "bar" (version "0") (replacement old))) (new (dummy-package "foo" (version "1") - (inputs `(("bar" ,bar))))) + (inputs (list bar)))) (tx (mock ((gnu packages) find-best-packages-by-name (const (list new))) (transaction-upgrade-entry @@ -275,13 +275,13 @@ (define read-at (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) (b (dummy-package "b" - (propagated-inputs `(("a" ,a))))) + (propagated-inputs (list a)))) (c (dummy-package "c" - (inputs `(("a" ,a))))) + (inputs (list a)))) (d (dummy-package "d" (propagated-inputs `(("x" "something.drv"))))) (e (dummy-package "e" - (inputs `(("b" ,b) ("c" ,c) ("d" ,d)))))) + (inputs (list b c d))))) (and (null? (package-transitive-inputs a)) (equal? `(("a" ,a)) (package-transitive-inputs b)) (equal? `(("a" ,a)) (package-transitive-inputs c)) @@ -327,19 +327,19 @@ (define read-at (b (dummy-package "b" (build-system trivial-build-system) (supported-systems '("x" "y")) - (inputs `(("a" ,a))))) + (inputs (list a)))) (c (dummy-package "c" (build-system trivial-build-system) (supported-systems '("y" "z")) - (inputs `(("b" ,b))))) + (inputs (list b)))) (d (dummy-package "d" (build-system trivial-build-system) (supported-systems '("x" "y" "z")) - (inputs `(("b" ,b) ("c" ,c))))) + (inputs (list b c)))) (e (dummy-package "e" (build-system trivial-build-system) (supported-systems '("x" "y" "z")) - (inputs `(("d" ,d)))))) + (inputs (list d))))) (list (package-transitive-supported-systems a) (package-transitive-supported-systems b) (package-transitive-supported-systems c) @@ -355,13 +355,13 @@ (define read-at (build-system trivial-build-system)))))) (let* ((a (dummy-package/no-implicit "a")) (b (dummy-package/no-implicit "b" - (propagated-inputs `(("a" ,a))))) + (propagated-inputs (list a)))) (c (dummy-package/no-implicit "c" - (inputs `(("a" ,a))))) + (inputs (list a)))) (d (dummy-package/no-implicit "d" - (native-inputs `(("b" ,b))))) + (native-inputs (list b)))) (e (dummy-package/no-implicit "e" - (inputs `(("c" ,c) ("d" ,d)))))) + (inputs (list c d))))) (lset= eq? (list a b c d e) (package-closure (list e)) @@ -384,12 +384,11 @@ (define read-at (u (dummy-origin)) (i (dummy-origin)) (a (dummy-package "a")) - (b (dummy-package "b" - (inputs `(("a" ,a) ("i" ,i))))) + (b (dummy-package "b" (inputs (list a i)))) (c (package (inherit b) (source o))) (d (dummy-package "d" (build-system trivial-build-system) - (source u) (inputs `(("c" ,c)))))) + (source u) (inputs (list c))))) (test-assert "package-direct-sources, no source" (null? (package-direct-sources a))) (test-equal "package-direct-sources, #f source" @@ -457,7 +456,7 @@ (define read-at (supported-systems '("x86_64-linux")))) (p (dummy-package "foo" (build-system gnu-build-system) - (inputs `(("d" ,d))) + (inputs (list d)) (supported-systems '("x86_64-linux" "armhf-linux"))))) (and (supported-package? p "x86_64-linux") (not (supported-package? p "i686-linux")) @@ -706,7 +705,7 @@ (define compressors '(("gzip" . "gz") (test-assert "package-derivation, inputs deduplicated" (let* ((dep (dummy-package "dep")) - (p0 (dummy-package "p" (inputs `(("dep" ,dep))))) + (p0 (dummy-package "p" (inputs (list dep)))) (p1 (package (inherit p0) (inputs `(("dep" ,(package (inherit dep))) ,@(package-inputs p0)))))) @@ -770,7 +769,7 @@ (define right-system? (parameterize ((%graft? #f)) (let* ((dep (dummy-package "dep")) (p (dummy-package "p" - (inputs `(("dep" ,dep "non-existent")))))) + (inputs (list `(,dep "non-existent")))))) (guard (c ((derivation-missing-output-error? c) (and (string=? (derivation-missing-output c) "non-existent") (equal? (package-derivation %store dep) @@ -928,12 +927,12 @@ (define right-system? (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))))) + (inputs (list p0)) + (propagated-inputs (list p1)))) (p3 (dummy-package "p3" (native-search-paths (sp "PATH3")) - (native-inputs `(("p0" ,p0))) - (propagated-inputs `(("p2" ,p2)))))) + (native-inputs (list p0)) + (propagated-inputs (list p2))))) (lset= string=? '("PATH1" "PATH2" "PATH3") (map search-path-specification-variable @@ -987,7 +986,7 @@ (define right-system? (dep* (package (inherit dep) (replacement new))) (dummy (dummy-package "dummy" (arguments '(#:implicit-inputs? #f)) - (inputs `(("dep" ,dep*)))))) + (inputs (list dep*))))) (equal? (package-grafts %store dummy) (list (graft (origin (package-derivation %store dep)) @@ -1019,11 +1018,11 @@ (define right-system? (dep (package (inherit new) (version "0.0"))) (dep* (package (inherit dep) (replacement new))) (prop (dummy-package "propagated" - (propagated-inputs `(("dep" ,dep*))) + (propagated-inputs (list dep*)) (arguments '(#:implicit-inputs? #f)))) (dummy (dummy-package "dummy" (arguments '(#:implicit-inputs? #f)) - (inputs `(("prop" ,prop)))))) + (inputs (list prop))))) (equal? (package-grafts %store dummy) (list (graft (origin (package-derivation %store dep)) @@ -1036,16 +1035,16 @@ (define right-system? (dep (package (inherit new) (version "0") (replacement new))) (p1 (dummy-package "intermediate1" (arguments '(#:implicit-inputs? #f)) - (inputs `(("dep" ,dep))))) + (inputs (list 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))))))) + (inputs (list (package (inherit dep)))))) (p3 (dummy-package "final" (arguments '(#:implicit-inputs? #f)) - (inputs `(("p1" ,p1) ("p2" ,p2)))))) + (inputs (list p1 p2))))) (equal? (package-grafts %store p3) (list (graft (origin (package-derivation %store @@ -1063,8 +1062,7 @@ (define right-system? (p0* (package (inherit p0) (version "1.1"))) (p1 (dummy-package "p1" (arguments '(#:implicit-inputs? #f)) - (inputs `(("p0" ,p0) - ("p0:lib" ,p0 "lib")))))) + (inputs (list p0 `(,p0 "lib")))))) (lset= equal? (pk (package-grafts %store p1)) (list (graft (origin (package-derivation %store p0)) @@ -1112,7 +1110,7 @@ (define right-system? #t))))) (p2r (dummy-package "P2" (build-system trivial-build-system) - (inputs `(("p1" ,p1))) + (inputs (list p1)) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out"))) @@ -1133,7 +1131,7 @@ (define right-system? #t))))) (p3 (dummy-package "p3" (build-system trivial-build-system) - (inputs `(("p2" ,p2))) + (inputs (list p2)) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out"))) @@ -1202,7 +1200,7 @@ (define right-system? (lower lower))) (dep (dummy-package "dep" (build-system bs))) (pkg (dummy-package "example" - (native-inputs `(("dep" ,dep))))) + (native-inputs (list dep)))) (do-not-build (lambda (continue store lst . _) lst))) (equal? (with-build-handler do-not-build (parameterize ((%current-target-system "powerpc64le-linux-gnu") @@ -1229,9 +1227,9 @@ (define right-system? (test-assert "package->bag, propagated inputs" (let* ((dep (dummy-package "dep")) (prop (dummy-package "prop" - (propagated-inputs `(("dep" ,dep))))) + (propagated-inputs (list dep)))) (dummy (dummy-package "dummy" - (inputs `(("prop" ,prop))))) + (inputs (list prop)))) (inputs (bag-transitive-inputs (package->bag dummy #:graft? #f)))) (match (assoc "dep" inputs) (("dep" package) @@ -1244,7 +1242,7 @@ (define right-system? `(("libxml2" ,libxml2)) '())))) (pkg (dummy-package "foo" - (native-inputs `(("dep" ,dep))))) + (native-inputs (list dep)))) (bag (package->bag pkg (%current-system) "i586-gnu"))) (equal? (parameterize ((%current-system "x86_64-linux")) (bag-transitive-inputs bag)) @@ -1257,7 +1255,7 @@ (define right-system? `(("libxml2" ,libxml2)) '())))) (pkg (dummy-package "foo" - (native-inputs `(("dep" ,dep))))) + (native-inputs (list dep)))) (bag (package->bag pkg (%current-system) "foo86-hurd"))) (equal? (parameterize ((%current-target-system "foo64-gnu")) (bag-transitive-inputs bag)) @@ -1563,11 +1561,11 @@ (define toolchain-packages (build-system trivial-build-system))) (glib (dummy-package "glib" (build-system trivial-build-system) - (propagated-inputs `(("libffi" ,libffi))))) + (propagated-inputs (list libffi)))) (gobject (dummy-package "gobject-introspection" (build-system trivial-build-system) - (inputs `(("glib" ,glib))) - (propagated-inputs `(("libffi" ,libffi))))) + (inputs (list glib)) + (propagated-inputs (list libffi)))) (rewrite (package-input-rewriting/spec `(("glib" . ,identity))))) (and (= (length (package-transitive-inputs gobject)) @@ -1584,11 +1582,11 @@ (define toolchain-packages (build-system trivial-build-system))) (glib (dummy-package "glib" (build-system trivial-build-system) - (propagated-inputs `(("libffi" ,libffi))))) + (propagated-inputs (list libffi)))) (gobject (dummy-package "gobject-introspection" (build-system trivial-build-system) - (inputs `(("glib" ,glib))) - (propagated-inputs `(("libffi" ,libffi))))) + (inputs (list glib)) + (propagated-inputs (list libffi)))) (rewrite (package-input-rewriting `((,glib . ,glib))))) (and (= (length (package-transitive-inputs gobject)) (length (package-transitive-inputs (rewrite gobject))))