From 8b192c5550213911f930594f4fd7386f36618237 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 13 Oct 2022 15:52:43 +0200
Subject: [PATCH] shell: Handle '--emulate-fhs' in 'guix shell', not in 'guix
 environment'.

Previously, using 'guix shell -CF coreutils' twice (such that the
profile is cache) would result in:

  guix shell: error: '--profile' cannot be used with package options

This patch fixes it by moving argument handling to (guix scripts shell),
before 'options-with-caching' is called.

* guix/scripts/environment.scm (show-environment-options-help)
(%options): Remove '--emulate-fhs'.
(guix-environment*): Pass OPTS as-is to 'options/resolve-packages'.
* guix/scripts/shell.scm (show-help, %options): Add '--emulate-fhs'.
Add the (expression . ...) component to RESULT right from the argument
handler.
* tests/guix-environment-container.sh: Change '--emulate-fhs' tests to
use 'guix shell' instead of 'guix environment'.
---
 guix/scripts/environment.scm        | 16 +---------------
 guix/scripts/shell.scm              | 18 +++++++++++++++++-
 tests/guix-environment-container.sh |  4 ++--
 3 files changed, 20 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index cf99760859..afe255fa4a 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -121,9 +121,6 @@ (define (show-environment-options-help)
       --expose=SPEC      for containers, expose read-only host file system
                          according to SPEC"))
   (display (G_ "
-  -F, --emulate-fhs      for containers, emulate the Filesystem Hierarchy
-                         Standard (FHS)"))
-  (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (G_ "
       --bootstrap        use bootstrap binaries to build the environment")))
@@ -260,9 +257,6 @@ (define %options
                    (alist-cons 'file-system-mapping
                                (specification->file-system-mapping arg #f)
                                result)))
-         (option '(#\F "emulate-fhs") #f #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'emulate-fhs? #t result)))
          (option '(#\r "root") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'gc-root arg result)))
@@ -1030,15 +1024,7 @@ (define-syntax-rule (with-store/maybe store exp ...)
       (with-store/maybe store
         (with-status-verbosity (assoc-ref opts 'verbosity)
           (define manifest-from-opts
-            (options/resolve-packages
-             store
-             ;; For an FHS-container, add the (hidden) package glibc-for-fhs
-             ;; which uses the global cache at /etc/ld.so.cache.
-             (if emulate-fhs?
-                 (alist-cons 'expression
-                             '(ad-hoc-package "(@@ (gnu packages base) glibc-for-fhs)")
-                             opts)
-                 opts)))
+            (options/resolve-packages store opts))
 
           (define manifest
             (if profile
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index c115a00320..a2836629ad 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -68,6 +68,9 @@ (define (show-help)
       --rebuild-cache    rebuild cached environment, if any"))
   (display (G_ "
       --export-manifest  print a manifest for the given options"))
+  (display (G_ "
+  -F, --emulate-fhs      for containers, emulate the Filesystem Hierarchy
+                         Standard (FHS)"))
 
   (show-environment-options-help)
   (newline)
@@ -136,7 +139,20 @@ (define %options
                         (alist-cons 'explicit-loading? #t result)))
               (option '("rebuild-cache") #f #f
                       (lambda (opt name arg result)
-                        (alist-cons 'rebuild-cache? #t result))))
+                        (alist-cons 'rebuild-cache? #t result)))
+
+              (option '(#\F "emulate-fhs") #f #f
+                      (lambda (opt name arg result)
+                        (let ((result
+                               ;; For an FHS-container, add the (hidden)
+                               ;; package glibc-for-fhs which uses the global
+                               ;; cache at /etc/ld.so.cache.
+                               (alist-cons
+                                'expression
+                                '(ad-hoc-package
+                                  "(@@ (gnu packages base) glibc-for-fhs)")
+                                result)))
+                         (alist-cons 'emulate-fhs? #t result)))))
         (filter-map (lambda (opt)
                       (and (not (any (lambda (name)
                                        (member name to-remove))
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index 898c57f41b..f233c3fcc0 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -217,7 +217,7 @@ fi
 # Test that the container has FHS specific files/directories.  Note that /bin
 # exists in a non-FHS container as it will contain sh, a symlink to the bash
 # package, so we don't test for it.
-guix environment -C --emulate-fhs --ad-hoc --bootstrap guile-bootstrap \
+guix shell -C --emulate-fhs --bootstrap guile-bootstrap \
      -- guile -c '(exit (and (file-exists? "/etc/ld.so.cache")
                              (file-exists? "/lib")
                              (file-exists? "/sbin")
@@ -229,5 +229,5 @@ guix environment -C --emulate-fhs --ad-hoc --bootstrap guile-bootstrap \
                              (file-exists? "/usr/share")))'
 
 # Test that the ld cache was generated and can be successfully read.
-guix environment -C --emulate-fhs --ad-hoc --bootstrap guile-bootstrap \
+guix shell -CF --bootstrap guile-bootstrap \
      -- guile -c '(execlp "ldconfig" "ldconfig" "-p")'