03/12: profiles: 'profile-derivation' rejects unsupported packages.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 5a57313918a5c1bd5cf8238c2dcae64a03523952
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Feb 17 16:06:39 2022 +0100

    profiles: 'profile-derivation' rejects unsupported packages.
    
    Previously user-facing commands would happily start building packages
    even if they do not support that system.  With this change, all the
    user-facing commands reject unsupported packages without going further.
    
    * guix/profiles.scm (profile-derivation): Add #:allow-unsupported-packages?.
    Define 'check-supported-packages' and honor #:allow-unsupported-packages?.
    * tests/guix-pack.sh, tests/guix-package.sh, tests/guix-shell.sh: Ensure
    that unsupported packages are rejected.
    * tests/guix-system.sh: Pass "--system=armhf-linux" when attempting to
    build gnu/system/examples/asus-c201.tmpl.
---
 guix/profiles.scm     | 22 ++++++++++++++++++++--
 tests/guix-pack.sh    |  5 ++++-
 tests/guix-package.sh | 13 ++++++++++++-
 tests/guix-shell.sh   |  5 ++++-
 tests/guix-system.sh  | 12 ++++++++----
 5 files changed, 48 insertions(+), 9 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 9715a769aa..bad9b95519 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -33,7 +33,7 @@
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
                 #:select (package-name->name+version mkdir-p))
-  #:use-module ((guix diagnostics) #:select (&fix-hint))
+  #:use-module ((guix diagnostics) #:select (&fix-hint formatted-message))
   #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
@@ -1860,6 +1860,7 @@ MANIFEST."
                              (name "profile")
                              (hooks %default-profile-hooks)
                              (locales? #t)
+                             (allow-unsupported-packages? #f)
                              (allow-collisions? #f)
                              (relative-symlinks? #f)
                              system target)
@@ -1868,7 +1869,9 @@ the given MANIFEST.  The profile includes additional 
derivations returned by
 the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
 Unless ALLOW-COLLISIONS? is true, a '&profile-collision-error' is raised if
 entries in MANIFEST collide (for instance if there are two same-name packages
-with a different version number.)
+with a different version number.)  Unless ALLOW-UNSUPPORTED-PACKAGES? is true
+or TARGET is set, raise an error if MANIFEST contains a package that does not
+support SYSTEM.
 
 When LOCALES? is true, the build is performed under a UTF-8 locale; this adds
 a dependency on the 'glibc-utf8-locales' package.
@@ -1878,12 +1881,27 @@ This is one of the things to do for the result to be 
relocatable.
 
 When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST
 are cross-built for TARGET."
+  (define (check-supported-packages system)
+    ;; Raise an error if a package in MANIFEST does not support SYSTEM.
+    (map-manifest-entries
+     (lambda (entry)
+
+       (match (manifest-entry-item entry)
+         ((? package? package)
+          (unless (supported-package? package system)
+            (raise (formatted-message (G_ "package ~a does not support ~a")
+                                      (package-full-name package) system))))
+         (_ #t)))
+     manifest))
+
   (mlet* %store-monad ((system (if system
                                    (return system)
                                    (current-system)))
                        (target (if target
                                    (return target)
                                    (current-target-system)))
+                       (ok? -> (or allow-unsupported-packages? target
+                                   (check-supported-packages system)))
                        (ok?    (if allow-collisions?
                                    (return #t)
                                    (check-for-collisions manifest system
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 0339221ac2..1356a74083 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -1,6 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
-# Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -36,6 +36,9 @@ export GUIX_BUILD_OPTIONS
 test_directory="`mktemp -d`"
 trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
 
+# Reject unsuppoted packages.
+! guix pack intelmetool -s armhf-linux -n
+
 # Compute the derivation of a pack.
 drv="`guix pack coreutils -d --no-grafts`"
 guix gc -R "$drv" | grep "`guix build coreutils -d --no-grafts`"
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 92ab565c5b..d1b383d2ad 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 #
 # This file is part of GNU Guix.
@@ -59,6 +59,17 @@ test -L "$profile" && test -L "$profile-1-link"
 ! test -f "$profile-2-link"
 test -f "$profile/bin/guile"
 
+# Unsupported packages cannot be installed.
+! guix package -e '(begin (use-modules (guix) (gnu packages base)) (package 
(inherit sed) (supported-systems (list))))' -n
+case $(uname -m) in
+    x86_64|i[3456]86)
+       ! guix package -i novena-eeprom -n
+       break;;
+    *)
+       ! guix package -i intelmetool -n
+       break;;
+esac
+
 # Collisions are properly flagged (in this case, 'g-wrap' propagates
 # guile@2.2, which conflicts with guile@2.0.)
 ! guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 23ff1c5bcf..6340f90574 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -35,6 +35,9 @@ guix shell --bootstrap --pure guile-bootstrap -- guile 
--version
 # '--ad-hoc' is a thing of the past.
 ! guix shell --ad-hoc guile-bootstrap
 
+# Rejecting unsupported packages.
+! guix shell -s armhf-linux intelmetool -n
+
 # Ignoring unauthorized files.
 cat > "$tmpdir/guix.scm" <<EOF
 This is a broken guix.scm file.
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 6aab1f380a..044fd131d6 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès 
<ludo@gnu.org>
+# Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 #
@@ -336,11 +336,15 @@ rm "$tmpdir/search"
 # Verify that the examples can be built.
 for example in gnu/system/examples/*.tmpl; do
     if echo "$example" | grep hurd; then
-        target="--target=i586-pc-gnu"
+        options="--target=i586-pc-gnu"
+    elif echo "$example" | grep asus; then
+       # 'asus-c201.tmpl' uses 'linux-libre-arm-generic', which is an
+       # ARM-only package.
+        options="--system=armhf-linux"
     else
-        target=
+       options=""
     fi
-    guix system -n disk-image $target "$example"
+    guix system -n disk-image $options "$example"
 done
 
 # Verify that the images can be built.