GNU bug report logs - #49025
[PATCH core-updates 00/37] Support cross-compilation with meson

Previous Next

Full log

View this message in rfc822 format

From: Maxime Devos <maximedevos <at> telenet.be>
To: 49025 <at> debbugs.gnu.org
Cc: Mathieu Othacehe <othacehe <at> gnu.org>, Maxime Devos <maximedevos <at> telenet.be>
Subject: [bug#49025] [PATCH v6 05/22] packages: Define this-package-input and this-package-native-input.
Date: Wed, 14 Jul 2021 13:12:50 +0200

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.
---
 guix/packages.scm  | 29 +++++++++++++++++++++++++++++
 tests/packages.scm | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+)

diff --git a/guix/packages.scm b/guix/packages.scm
index 3ba61b42c9..56300e6b61 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -108,6 +108,9 @@
             deprecated-package
             package-field-location
 
+            this-package-input
+            this-package-native-input
+
             package-direct-sources
             package-transitive-sources
             package-direct-inputs
@@ -513,6 +516,32 @@ object."
         #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.
 
diff --git a/tests/packages.scm b/tests/packages.scm
index 47fc34d3ce..9814015a05 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke <at> gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1866,6 +1867,39 @@
   (package-location (specification->package "guile <at> 2"))
   (specification->location "guile <at> 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:
-- 
2.32.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.