~ruther/guix-local

2cdfe13deaf3d959e1ecb3a207cdbc28985e0e79 — Eric Bavier 11 years ago f77bcbc
guix: build: Add transitive source building.

* guix/scripts/build.scm (%options, options->derivations): Add --sources
  option.
* doc/guix.texi (Invoking guix build): Document --sources option.
* tests/guix-build.sh: Add tests.
3 files changed, 163 insertions(+), 17 deletions(-)

M doc/guix.texi
M guix/scripts/build.scm
M tests/guix-build.sh
M doc/guix.texi => doc/guix.texi +43 -0
@@ 2932,6 2932,49 @@ The returned source tarball is the result of applying any patches and
code snippets specified in the package's @code{origin} (@pxref{Defining
Packages}).

@item --sources
Fetch and return the source of @var{package-or-derivation} and all their
dependencies, recursively.  This is a handy way to obtain a local copy
of all the source code needed to build @var{packages}, allowing you to
eventually build them even without network access.  It is an extension
of the @code{--source} option and can accept one of the following
optional argument values:

@table @code
@item package
This value causes the @code{--sources} option to behave in the same way
as the @code{--source} option.

@item all
Build all packages' source derivations, including any source that might
be listed as @code{inputs}.  This is the default value.

@example
$ guix build --sources tzdata
The following derivations will be built:
   /gnu/store/@dots{}-tzdata2015b.tar.gz.drv
   /gnu/store/@dots{}-tzcode2015b.tar.gz.drv
@end example

@item transitive
Build all packages' source derivations, as well as all source
derivations for packages' transitive inputs.  This can be used e.g. to
prefetch package source for later offline building.

@example
$ guix build --sources=transitive tzdata
The following derivations will be built:
   /gnu/store/@dots{}-tzcode2015b.tar.gz.drv
   /gnu/store/@dots{}-findutils-4.4.2.tar.xz.drv
   /gnu/store/@dots{}-grep-2.21.tar.xz.drv
   /gnu/store/@dots{}-coreutils-8.23.tar.xz.drv
   /gnu/store/@dots{}-make-4.1.tar.xz.drv
   /gnu/store/@dots{}-bash-4.3.tar.xz.drv
@dots{}
@end example

@end table

@item --system=@var{system}
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of

M guix/scripts/build.scm => guix/scripts/build.scm +38 -17
@@ 228,6 228,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
  (display (_ "
  -S, --source           build the packages' source derivations"))
  (display (_ "
  --sources[=TYPE]       build source derivations; TYPE may optionally be one
                         of \"package\", \"all\" (default), or \"transitive\""))
  (display (_ "
  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
  (display (_ "
      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))


@@ 262,10 265,22 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix build")))

         (option '(#\S "source") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'source? #t result)))
                   (alist-cons 'source #t result)))
         (option '("sources") #f #t
                 (lambda (opt name arg result)
                   (match arg
                     ("package"
                      (alist-cons 'source #t result))
                     ((or "all" #f)
                      (alist-cons 'source package-direct-sources result))
                     ("transitive"
                      (alist-cons 'source package-transitive-sources result))
                     (else
                      (leave (_ "invalid argument: '~a' option argument: ~a, ~
must be one of 'package', 'all', or 'transitive'~%")
                             name arg)))))
         (option '(#\s "system") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'system arg


@@ 308,28 323,34 @@ build."
      (triplet
       (cut package-cross-derivation <> <> triplet <>))))

  (define src?   (assoc-ref opts 'source?))
  (define src    (assoc-ref opts 'source))
  (define sys    (assoc-ref opts 'system))
  (define graft? (assoc-ref opts 'graft?))

  (parameterize ((%graft? graft?))
    (let ((opts (options/with-source store
                                     (options/resolve-packages store opts))))
      (filter-map (match-lambda
                   (('argument . (? package? p))
                    (if src?
      (concatenate
       (filter-map (match-lambda
                    (('argument . (? package? p))
                     (match src
                       (#f
                        (list (package->derivation store p sys)))
                       (#t
                        (let ((s (package-source p)))
                          (package-source-derivation store s))
                        (package->derivation store p sys)))
                   (('argument . (? derivation? drv))
                    drv)
                   (('argument . (? derivation-path? drv))
                    (call-with-input-file drv read-derivation))
                   (('argument . (? store-path?))
                    ;; Nothing to do; maybe for --log-file.
                    #f)
                   (_ #f))
                  opts))))
                          (list (package-source-derivation store s))))
                       (proc
                        (map (cut package-source-derivation store <>)
                             (proc p)))))
                    (('argument . (? derivation? drv))
                     (list drv))
                    (('argument . (? derivation-path? drv))
                     (list (call-with-input-file drv read-derivation)))
                    (('argument . (? store-path?))
                     ;; Nothing to do; maybe for --log-file.
                     #f)
                    (_ #f))
                   opts)))))

(define (options/resolve-packages store opts)
  "Return OPTS with package specification strings replaced by actual

M tests/guix-build.sh => tests/guix-build.sh +82 -0
@@ 36,6 36,88 @@ (gnu packages bootstrap) %bootstrap-guile)' |	\
guix build hello -d |				\
    grep -e '-hello-[0-9\.]\+\.drv$'

# Check --sources option with its arguments
module_dir="t-guix-build-$$"
mkdir "$module_dir"
trap "rm -rf $module_dir" EXIT

cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system trivial))

(define-public foo
  (package
    (name "foo")
    (version "42")
    (source (origin
              (method url-fetch)
              (uri "http://www.example.com/foo.tar.gz")
              (sha256
               (base32
                "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"))))
    (build-system trivial-build-system)
    (inputs
     (quasiquote (("bar" ,bar))))
    (home-page "www.example.com")
    (synopsis "Dummy package")
    (description "foo is a dummy package for testing.")
    (license #f)))

(define-public bar
  (package
    (name "bar")
    (version "9001")
    (source (origin
              (method url-fetch)
              (uri "http://www.example.com/bar.tar.gz")
              (sha256
               (base32
                "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy"))))
    (build-system trivial-build-system)
    (inputs
     (quasiquote
      (("data" ,(origin
                 (method url-fetch)
                 (uri "http://www.example.com/bar.dat")
                 (sha256
                  (base32
                   "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz")))))))
    (home-page "www.example.com")
    (synopsis "Dummy package")
    (description "bar is a dummy package for testing.")
    (license #f)))
EOF

GUIX_PACKAGE_PATH="$module_dir"
export GUIX_PACKAGE_PATH

# foo.tar.gz
guix build -d -S foo
guix build -d -S foo | grep -e 'foo\.tar\.gz'

guix build -d --sources=package foo
guix build -d --sources=package foo | grep -e 'foo\.tar\.gz'

# bar.tar.gz and bar.dat
guix build -d --sources bar
test `guix build -d --sources bar \
      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
      | wc -l` -eq 2

# bar.tar.gz and bar.dat
guix build -d --sources=all bar
test `guix build -d --sources bar \
      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
      | wc -l` -eq 2

# Should include foo.tar.gz, bar.tar.gz, and bar.dat
guix build -d --sources=transitive foo
test `guix build -d --sources=transitive foo \
      | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
      | wc -l` -eq 3

# Should all return valid log files.
drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"