03/03: guix environment, build: Allow absolute file names with '--root'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 840f38ba37af1d09eb1e896a6350d6ab7f6532d0
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jan 18 16:57:56 2017 +0100

    guix environment, build: Allow absolute file names with '--root'.
    
    Reported by Chris Webber.
    
    * guix/scripts/build.scm (register-root): If ROOT is absolute, keep it
    as is.
    * guix/scripts/environment.scm (register-gc-root): Likewise.
    * tests/guix-environment.sh (expected): Add test.
---
 guix/scripts/build.scm       |    6 ++++--
 guix/scripts/environment.scm |    8 +++++---
 tests/guix-environment.sh    |    7 ++++++-
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 8326d64..d7d71b7 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -99,8 +99,10 @@ found.  Return #f if no build log was found."
 
 (define (register-root store paths root)
   "Register ROOT as an indirect GC root for all of PATHS."
-  (let* ((root (string-append (canonicalize-path (dirname root))
-                              "/" root)))
+  (let* ((root (if (string-prefix? "/" root)
+                   root
+                   (string-append (canonicalize-path (dirname root))
+                                  "/" root))))
     (catch 'system-error
       (lambda ()
         (match paths
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 1d3be6a..a08367d 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015 David Thompson <address@hidden>
-;;; Copyright © 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -531,8 +531,10 @@ message if any test fails."
 
 (define (register-gc-root target root)
   "Make ROOT an indirect root to TARGET.  This is procedure is idempotent."
-  (let* ((root (string-append (canonicalize-path (dirname root))
-                              "/" root)))
+  (let* ((root (if (string-prefix? "/" root)
+                   root
+                   (string-append (canonicalize-path (dirname root))
+                                  "/" root))))
     (catch 'system-error
       (lambda ()
         (symlink target root)
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index 2b3bbfe..9115949 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2015, 2016 Ludovic Courtès <address@hidden>
+# Copyright © 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 #
 # This file is part of GNU Guix.
 #
@@ -74,7 +74,12 @@ test `readlink "$gcroot"` = "$expected"
 guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
      -- guile -c 1
 test `readlink "$gcroot"` = "$expected"
+rm "$gcroot"
 
+# Same with an absolute file name.
+guix environment --bootstrap -r "$PWD/$gcroot" --ad-hoc guile-bootstrap \
+     -- guile -c 1
+test `readlink "$gcroot"` = "$expected"
 
 case "`uname -m`" in
     x86_64)