kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

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

Browse Source 
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.
This commit is contained in:
Ludovic Courtès 2017-01-18 16:57:56 +01:00
parent 67fee545cc
commit 840f38ba37
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
guix/scripts/build.scm
View File

@ -99,8 +99,10 @@ found. Return #f if no build log was found."
(define (register-root store paths root) (define (register-root store paths root)
"Register ROOT as an indirect GC root for all of PATHS." "Register ROOT as an indirect GC root for all of PATHS."
(let* ((root (string-append (canonicalize-path (dirname root)) (let* ((root (if (string-prefix? "/" root)
"/" root))) root
(string-append (canonicalize-path (dirname root))
"/" root))))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(match paths (match paths

8
guix/scripts/environment.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2014, 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -531,8 +531,10 @@ message if any test fails."
(define (register-gc-root target root) (define (register-gc-root target root)
"Make ROOT an indirect root to TARGET. This is procedure is idempotent." "Make ROOT an indirect root to TARGET. This is procedure is idempotent."
(let* ((root (string-append (canonicalize-path (dirname root)) (let* ((root (if (string-prefix? "/" root)
"/" root))) root
(string-append (canonicalize-path (dirname root))
"/" root))))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(symlink target root) (symlink target root)

7
tests/guix-environment.sh
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> # Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
# #
@ -74,7 +74,12 @@ test `readlink "$gcroot"` = "$expected"
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \ guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
-- guile -c 1 -- guile -c 1
test `readlink "$gcroot"` = "$expected" 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 case "`uname -m`" in
x86_64) x86_64)