build-system: cargo: Handle Cargo.lock file not present.

* guix/build-system/cargo.scm (cargo-build): Add src output.
  (private-keywords): Add #:outputs.
* guix/build/cargo-build-system.scm (configure): Use /share/rust-source
  when replacing inputs.
  (build, check): Don't do anything when there isn't a Cargo.lock file
  present.
  (install): Install sources to src output. When a Cargo.lock file is
  present use cargo install to install binaries to out.
* guix/import/crate.scm (make-crate-sexp): Importer uses the src output
  for crate inputs by default.
* guix/import/utils.scm (package-names->package-inputs, maybe-inputs,
  maybe-native-inputs): Take an optional output argument.
* tests/crate.scm (crate->guix-package test): Update.

Problem reported by Francisco Gómez García <espectalll@kydara.com>.
This commit is contained in:
David Craven 2016-12-29 16:29:24 +01:00
parent f53a5514e0
commit f1d136957d
No known key found for this signature in database
GPG Key ID: C5E051C79C0BECDB
5 changed files with 25 additions and 19 deletions

View File

@ -109,7 +109,7 @@ to NAME and VERSION."
#:inputs inputs #:inputs inputs
#:system system #:system system
#:modules imported-modules #:modules imported-modules
#:outputs outputs #:outputs (cons "src" outputs)
#:guile-for-build guile-for-build)) #:guile-for-build guile-for-build))
(define* (lower name (define* (lower name
@ -121,7 +121,7 @@ to NAME and VERSION."
"Return a bag for NAME." "Return a bag for NAME."
(define private-keywords (define private-keywords
'(#:source #:target #:cargo #:rustc #:inputs #:native-inputs)) '(#:source #:target #:cargo #:rustc #:inputs #:native-inputs #:outputs))
(and (not target) ;; TODO: support cross-compilation (and (not target) ;; TODO: support cross-compilation
(bag (bag

View File

@ -54,7 +54,7 @@
(when (and crate path) (when (and crate path)
(match (string-split (basename path) #\-) (match (string-split (basename path) #\-)
((_ ... version) ((_ ... version)
(format port "\"~a:~a\" = { path = \"~a/rustsrc\" }~%" (format port "\"~a:~a\" = { path = \"~a/share/rust-source\" }~%"
crate version path))))))) crate version path)))))))
inputs) inputs)
(close-port port)) (close-port port))
@ -63,19 +63,22 @@
(define* (build #:key (cargo-build-flags '("--release" "--frozen")) (define* (build #:key (cargo-build-flags '("--release" "--frozen"))
#:allow-other-keys) #:allow-other-keys)
"Build a given Cargo package." "Build a given Cargo package."
(zero? (apply system* `("cargo" "build" ,@cargo-build-flags)))) (if (file-exists? "Cargo.lock")
(zero? (apply system* `("cargo" "build" ,@cargo-build-flags)))
#t))
(define* (check #:key tests? #:allow-other-keys) (define* (check #:key tests? #:allow-other-keys)
"Run tests for a given Cargo package." "Run tests for a given Cargo package."
(when tests? (if (and tests? (file-exists? "Cargo.lock"))
(zero? (system* "cargo" "test")))) (zero? (system* "cargo" "test"))
#t))
(define* (install #:key inputs outputs #:allow-other-keys) (define* (install #:key inputs outputs #:allow-other-keys)
"Install a given Cargo package." "Install a given Cargo package."
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(src (assoc-ref inputs "source")) (src (assoc-ref inputs "source"))
(bin (string-append out "/bin")) (rsrc (string-append (assoc-ref outputs "src")
(rsrc (string-append out "/rustsrc"))) "/share/rust-source")))
(mkdir-p rsrc) (mkdir-p rsrc)
;; Rust doesn't have a stable ABI yet. Because of this ;; Rust doesn't have a stable ABI yet. Because of this
;; Cargo doesn't have a search path for binaries yet. ;; Cargo doesn't have a search path for binaries yet.
@ -87,8 +90,9 @@
;; When the package includes executables we install ;; When the package includes executables we install
;; it using cargo install. This fails when the crate ;; it using cargo install. This fails when the crate
;; doesn't contain an executable. ;; doesn't contain an executable.
(system* "cargo" "install" "--root" bin) (if (file-exists? "Cargo.lock")
#t)) (system* "cargo" "install" "--root" out)
(mkdir out))))
(define %standard-phases (define %standard-phases
;; 'configure' phase is not needed. ;; 'configure' phase is not needed.

View File

@ -97,8 +97,8 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(base32 (base32
,(bytevector->nix-base32-string (port-sha256 port)))))) ,(bytevector->nix-base32-string (port-sha256 port))))))
(build-system cargo-build-system) (build-system cargo-build-system)
,@(maybe-native-inputs native-inputs) ,@(maybe-native-inputs native-inputs "src")
,@(maybe-inputs inputs) ,@(maybe-inputs inputs "src")
(home-page ,(match home-page (home-page ,(match home-page
(() "") (() "")
(_ home-page))) (_ home-page)))

View File

@ -211,24 +211,26 @@ into a proper sentence and by using two spaces between sentences."
(regexp-substitute/global #f "\\. \\b" (regexp-substitute/global #f "\\. \\b"
cleaned 'pre ". " 'post))) cleaned 'pre ". " 'post)))
(define (package-names->package-inputs names) (define* (package-names->package-inputs names #:optional (output #f))
(map (lambda (input) (map (lambda (input)
(list input (list 'unquote (string->symbol input)))) (cons* input (list 'unquote (string->symbol input))
(or (and output (list output))
'())))
names)) names))
(define (maybe-inputs package-names) (define* (maybe-inputs package-names #:optional (output #f))
"Given a list of PACKAGE-NAMES, tries to generate the 'inputs' field of a "Given a list of PACKAGE-NAMES, tries to generate the 'inputs' field of a
package definition." package definition."
(match (package-names->package-inputs package-names) (match (package-names->package-inputs package-names output)
(() (()
'()) '())
((package-inputs ...) ((package-inputs ...)
`((inputs (,'quasiquote ,package-inputs)))))) `((inputs (,'quasiquote ,package-inputs))))))
(define (maybe-native-inputs package-names) (define* (maybe-native-inputs package-names #:optional (output #f))
"Given a list of PACKAGE-NAMES, tries to generate the 'inputs' field of a "Given a list of PACKAGE-NAMES, tries to generate the 'inputs' field of a
package definition." package definition."
(match (package-names->package-inputs package-names) (match (package-names->package-inputs package-names output)
(() (()
'()) '())
((package-inputs ...) ((package-inputs ...)

View File

@ -91,7 +91,7 @@
('build-system 'cargo-build-system) ('build-system 'cargo-build-system)
('inputs ('inputs
('quasiquote ('quasiquote
(("rust-bar" ('unquote 'rust-bar))))) (("rust-bar" ('unquote 'rust-bar) "src"))))
('home-page "http://example.com") ('home-page "http://example.com")
('synopsis "summary") ('synopsis "summary")
('description "summary") ('description "summary")