aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi28
-rw-r--r--guix/scripts/build.scm108
2 files changed, 122 insertions, 14 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 701b5400f8..d2a21a0f4a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1840,6 +1840,34 @@ Cross-build for @var{triplet}, which must be a valid GNU triplet, such
as @code{"mips64el-linux-gnu"} (@pxref{Configuration Names, GNU
configuration triplets,, configure, GNU Configure and Build System}).
+@item --with-source=@var{source}
+Use @var{source} as the source of the corresponding package.
+@var{source} must be a file name or a URL, as for @command{guix
+download} (@pxref{Invoking guix download}).
+
+The ``corresponding package'' is taken to be one specified on the
+command line whose name matches the base of @var{source}---e.g., if
+@var{source} is @code{/src/guile-2.0.10.tar.gz}, the corresponding
+package is @code{guile}. Likewise, the version string is inferred from
+@var{source}; in the previous example, it's @code{2.0.10}.
+
+This option allows users to try out versions of packages other than the
+one provided by the distribution. The example below downloads
+@file{ed-1.7.tar.gz} from a GNU mirror and uses that as the source for
+the @code{ed} package:
+
+@example
+guix build ed --with-source=mirror://gnu/ed/ed-1.7.tar.gz
+@end example
+
+As a developer, @code{--with-source} makes it easy to test release
+candidates:
+
+@example
+guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz
+@end example
+
+
@item --derivations
@itemx -d
Return the derivation paths, not the output paths, of the given
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 618015e9ba..8f6ba192c2 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -33,6 +33,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:autoload (gnu packages) (find-best-packages-by-name)
+ #:autoload (guix download) (download-to-store)
#:export (derivation-from-expression
%standard-build-options
@@ -104,6 +105,31 @@ present, return the preferred newest version."
(leave (_ "failed to create GC root `~a': ~a~%")
root (strerror (system-error-errno args)))))))
+(define (package-with-source store p uri)
+ "Return a package based on P but with its source taken from URI. Extract
+the new package's version number from URI."
+ (define (numeric-extension? file-name)
+ ;; Return true if FILE-NAME ends with digits.
+ (string-every char-set:hex-digit (file-extension file-name)))
+
+ (define (tarball-base-name file-name)
+ ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar
+ ;; extensions.
+ ;; TODO: Factorize.
+ (cond ((numeric-extension? file-name)
+ file-name)
+ ((string=? (file-extension file-name) "tar")
+ (file-sans-extension file-name))
+ (else
+ (tarball-base-name (file-sans-extension file-name)))))
+
+ (let ((base (tarball-base-name (basename uri))))
+ (let-values (((name version)
+ (package-name->name+version base)))
+ (package (inherit p)
+ (version (or version (package-version p)))
+ (source (download-to-store store uri))))))
+
;;;
;;; Standard command-line build options.
@@ -222,6 +248,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ "
--target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
(display (_ "
+ --with-source=SOURCE
+ use SOURCE when building the corresponding package"))
+ (display (_ "
-d, --derivations return the derivation paths of the given packages"))
(display (_ "
-r, --root=FILE make FILE a symlink to the result, and register it
@@ -274,6 +303,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(option '("log-file") #f #f
(lambda (opt name arg result)
(alist-cons 'log-file? #t result)))
+ (option '("with-source") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'with-source arg result)))
%standard-build-options))
@@ -289,23 +321,71 @@ build."
(define src? (assoc-ref opts 'source?))
(define sys (assoc-ref opts 'system))
- (filter-map (match-lambda
- (('expression . str)
- (derivation-from-expression store str package->derivation
- sys src?))
- (('argument . (? derivation-path? drv))
- (call-with-input-file drv read-derivation))
- (('argument . (? store-path?))
- ;; Nothing to do; maybe for --log-file.
- #f)
- (('argument . (? string? x))
- (let ((p (specification->package x)))
+ (let ((opts (options/with-source store
+ (options/resolve-packages opts))))
+ (filter-map (match-lambda
+ (('expression . str)
+ (derivation-from-expression store str package->derivation
+ sys src?))
+ (('argument . (? package? p))
(if src?
(let ((s (package-source p)))
(package-source-derivation store s))
- (package->derivation store p sys))))
- (_ #f))
- opts))
+ (package->derivation store p sys)))
+ (('argument . (? derivation-path? drv))
+ (call-with-input-file drv read-derivation))
+ (('argument . (? store-path?))
+ ;; Nothing to do; maybe for --log-file.
+ #f)
+ (_ #f))
+ opts)))
+
+(define (options/resolve-packages opts)
+ "Return OPTS with package specification strings replaced by actual
+packages."
+ (map (match-lambda
+ (('argument . (? string? spec))
+ (if (store-path? spec)
+ `(argument . ,spec)
+ `(argument . ,(specification->package spec))))
+ (opt opt))
+ opts))
+
+(define (options/with-source store opts)
+ "Process with 'with-source' options in OPTS, replacing the relevant package
+arguments with packages that use the specified source."
+ (define new-sources
+ (filter-map (match-lambda
+ (('with-source . uri)
+ (cons (package-name->name+version (basename uri))
+ uri))
+ (_ #f))
+ opts))
+
+ (let loop ((opts opts)
+ (sources new-sources)
+ (result '()))
+ (match opts
+ (()
+ (unless (null? sources)
+ (warning (_ "sources do not match any package:~{ ~a~}~%")
+ (match sources
+ (((name . uri) ...)
+ uri))))
+ (reverse result))
+ ((('argument . (? package? p)) tail ...)
+ (let ((source (assoc-ref sources (package-name p))))
+ (loop tail
+ (alist-delete (package-name p) sources)
+ (alist-cons 'argument
+ (if source
+ (package-with-source store p source)
+ p)
+ result))))
+ ((('with-source . _) tail ...)
+ (loop tail sources result))
+ ((head tail ...)
+ (loop tail sources (cons head result))))))
;;;