ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

union: Add create-all-directories? parameter to 'union-build'.

Browse source 
* guix/build/union.scm (union-build): Add create-all-directories? keyword
parameter.
* tests/union.scm ("union-build #:create-all-directories? #t"): New test.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Huang Ying 2017-03-12 19:53:58 +08:00 committed by Ludovic Courtès
parent 7398d96ee9
commit addce19e2d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 33 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/build/union.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -73,9 +74,12 @@ (define buf2 (make-bytevector len))
(loop)))))))))))))
(define* (union-build output inputs
#:key (log-port (current-error-port)))
"Build in the OUTPUT directory a symlink tree that is the union of all
the INPUTS."
#:key (log-port (current-error-port))
(create-all-directories? #f))
"Build in the OUTPUT directory a symlink tree that is the union of all the
INPUTS. As a special case, if CREATE-ALL-DIRECTORIES?, creates the
subdirectories in the output directory to make sure the caller can modify them
later."
(define (symlink* input output)
(format log-port "`~a' ~~> `~a'~%" input output)
@ -104,8 +108,11 @@ (define (resolve-collisions output dirs files)
(define (union output inputs)
(match inputs
((input)
;; There's only one input, so just make a link.
(symlink* input output))
;; There's only one input, so just make a link unless
;; create-all-directories?.
(if (and create-all-directories? (file-is-directory? input))
(union-of-directories output inputs)
(symlink* input output)))
(_
(call-with-values (lambda () (partition file-is-directory? inputs))
(match-lambda*

22
tests/union.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -124,4 +124,24 @@ (define %store
;; new 'bin' sub-directory in the profile.
(eq? 'directory (stat:type (lstat "bin"))))))))
(test-assert "union-build #:create-all-directories? #t"
(let* ((build `(begin
(use-modules (guix build union))
(union-build (assoc-ref %outputs "out")
(map cdr %build-inputs)
#:create-all-directories? #t)))
(input (package-derivation %store %bootstrap-guile))
(drv (build-expression->derivation %store "union-test-all-dirs"
build
#:modules '((guix build union))
#:inputs `(("g" ,input)))))
(and (build-derivations %store (list drv))
(with-directory-excursion (derivation->output-path drv)
;; Even though there's only one input to the union,
;; #:create-all-directories? #t must have created bin/ rather than
;; making it a symlink to Guile's bin/.
(and (file-exists? "bin/guile")
(file-is-directory? "bin")
(eq? 'symlink (stat:type (lstat "bin/guile"))))))))
(test-end)