packages: Define this-package-input and this-package-native-input.

These macros are intended to be used in build phases.
More precisely, (assoc-ref %build-inputs "input") can be
replaced by #$(this-package-input "input") or #+(this-package-native-input
"native-input") as appropriate.

* guix/packages.scm
  (package-input, package-native-input): New (unexported) procedures.
  (this-package-input, this-package-native-input): New macros.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
Maxime Devos 2021-07-14 13:12:50 +02:00 committed by Mathieu Othacehe
parent f54852be22
commit aaf9aa4824
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 63 additions and 0 deletions

View file

@ -109,6 +109,9 @@ (define-module (guix packages)
deprecated-package
package-field-location
this-package-input
this-package-native-input
lookup-package-input
lookup-package-native-input
lookup-package-propagated-input
@ -547,6 +550,32 @@ (define (package-field-location package field)
#f)))
(_ #f)))
(define (package-input package name)
"Return the package input NAME of PACKAGE--i.e., an input
from the inputs or propagated-inputs field. Native inputs are not
considered. If this input does not exist, return #f instead."
(and=> (or (assoc-ref (package-inputs package) name)
(assoc-ref (package-propagated-inputs package) name))
car))
(define (package-native-input package name)
"Return the native package input NAME of PACKAGE--i.e., an input
from the native-inputs field. If this native input does not exist,
return #f instead."
(and=> (assoc-ref (package-native-inputs package) name)
car))
(define-syntax-rule (this-package-input name)
"Return the input NAME of the package being defined--i.e., an input
from the inputs or propagated-inputs field. Native inputs are not
considered. If this input does not exist, return #f instead."
(package-input this-package name))
(define-syntax-rule (this-package-native-input name)
"Return the native package input NAME of the package being defined--i.e.,
an input from the native-inputs field. If this native input does not
exist, return #f instead."
(package-native-input this-package name))
;; Error conditions.

View file

@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1864,6 +1865,39 @@ (define (list->set* lst)
(package-location (specification->package "guile@2"))
(specification->location "guile@2"))
(test-eq "this-package-input, exists"
hello
(package-arguments
(dummy-package "a"
(inputs `(("hello" ,hello)))
(arguments (this-package-input "hello")))))
(test-eq "this-package-input, exists in propagated-inputs"
hello
(package-arguments
(dummy-package "a"
(propagated-inputs `(("hello" ,hello)))
(arguments (this-package-input "hello")))))
(test-eq "this-package-input, does not exist"
#f
(package-arguments
(dummy-package "a"
(arguments (this-package-input "hello")))))
(test-eq "this-package-native-input, exists"
hello
(package-arguments
(dummy-package "a"
(native-inputs `(("hello" ,hello)))
(arguments (this-package-native-input "hello")))))
(test-eq "this-package-native-input, does not exists"
#f
(package-arguments
(dummy-package "a"
(arguments (this-package-native-input "hello")))))
(test-end "packages")
;;; Local Variables: