guix build: Allow directories to be passed to --with-source.

* guix/scripts/build.scm (package-with-source)[tarball-base-name]: Gracefully
  handle file names that lack an extension.
  Pass #:recursive? #t to 'download-to-store'.
* guix/download.scm (download-to-store): Add #:recursive? parameter and pass
  it to 'add-to-store'.
* doc/guix.texi (Invoking guix build): Add an example of --with-source with a
  directory.
This commit is contained in:
Ludovic Courtès 2015-06-11 11:19:12 +02:00
parent c2590362ad
commit a43b55f1a6
3 changed files with 22 additions and 7 deletions

View file

@ -3438,6 +3438,13 @@ candidates:
guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz
@end example @end example
@dots{} or to build from a checkout in a pristine environment:
@example
$ git clone git://git.sv.gnu.org/guix.git
$ guix build guix --with-source=./guix
@end example
@item --no-grafts @item --no-grafts
Do not ``graft'' packages. In practice, this means that package updates Do not ``graft'' packages. In practice, this means that package updates
available as grafts are not applied. @xref{Security Updates}, for more available as grafts are not applied. @xref{Security Updates}, for more

View file

@ -282,14 +282,15 @@ (define builder
))))) )))))
(define* (download-to-store store url #:optional (name (basename url)) (define* (download-to-store store url #:optional (name (basename url))
#:key (log (current-error-port))) #:key (log (current-error-port)) recursive?)
"Download from URL to STORE, either under NAME or URL's basename if "Download from URL to STORE, either under NAME or URL's basename if
omitted. Write progress reports to LOG." omitted. Write progress reports to LOG. RECURSIVE? has the same effect as
the same-named parameter of 'add-to-store'."
(define uri (define uri
(string->uri url)) (string->uri url))
(if (or (not uri) (memq (uri-scheme uri) '(file #f))) (if (or (not uri) (memq (uri-scheme uri) '(file #f)))
(add-to-store store name #f "sha256" (add-to-store store name recursive? "sha256"
(if uri (uri-path uri) url)) (if uri (uri-path uri) url))
(call-with-temporary-output-file (call-with-temporary-output-file
(lambda (temp port) (lambda (temp port)
@ -298,6 +299,6 @@ (define uri
(build:url-fetch url temp #:mirrors %mirrors)))) (build:url-fetch url temp #:mirrors %mirrors))))
(close port) (close port)
(and result (and result
(add-to-store store name #f "sha256" temp))))))) (add-to-store store name recursive? "sha256" temp)))))))
;;; download.scm ends here ;;; download.scm ends here

View file

@ -77,19 +77,26 @@ (define (tarball-base-name file-name)
;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar
;; extensions. ;; extensions.
;; TODO: Factorize. ;; TODO: Factorize.
(cond ((numeric-extension? file-name) (cond ((not (file-extension file-name))
file-name)
((numeric-extension? file-name)
file-name) file-name)
((string=? (file-extension file-name) "tar") ((string=? (file-extension file-name) "tar")
(file-sans-extension file-name)) (file-sans-extension file-name))
((file-extension file-name)
(tarball-base-name (file-sans-extension file-name)))
(else (else
(tarball-base-name (file-sans-extension file-name))))) file-name)))
(let ((base (tarball-base-name (basename uri)))) (let ((base (tarball-base-name (basename uri))))
(let-values (((name version) (let-values (((name version)
(package-name->name+version base))) (package-name->name+version base)))
(package (inherit p) (package (inherit p)
(version (or version (package-version p))) (version (or version (package-version p)))
(source (download-to-store store uri))))))
;; Use #:recursive? #t to allow for directories.
(source (download-to-store store uri
#:recursive? #t))))))
;;; ;;;