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. @@ -221,6 +247,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (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 (_ " @@ -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)))))) ;;;