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

[David Craven]

dvc pushed a commit to branch master
in repository guix.

commit f1d136957d0d5634e60e5389a046a917169cdb9e
Author: David Craven <address@hidden>
Date:   Thu Dec 29 16:29:24 2016 +0100

    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 <address@hidden>.
---
 guix/build-system/cargo.scm       |    4 ++--
 guix/build/cargo-build-system.scm |   20 ++++++++++++--------
 guix/import/crate.scm             |    4 ++--
 guix/import/utils.scm             |   14 ++++++++------
 tests/crate.scm                   |    2 +-
 5 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index 8d835dd..ffc0afd 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -109,7 +109,7 @@ to NAME and VERSION."
                                 #:inputs inputs
                                 #:system system
                                 #:modules imported-modules
-                                #:outputs outputs
+                                #:outputs (cons "src" outputs)
                                 #:guile-for-build guile-for-build))
 
 (define* (lower name
@@ -121,7 +121,7 @@ to NAME and VERSION."
   "Return a bag for NAME."
 
   (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
        (bag
diff --git a/guix/build/cargo-build-system.scm 
b/guix/build/cargo-build-system.scm
index 4fa29b4..7d656a8 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -54,7 +54,7 @@
           (when (and crate path)
             (match (string-split (basename path) #\-)
               ((_ ... version)
-               (format port "\"~a:~a\" = { path = \"~a/rustsrc\" }~%"
+               (format port "\"~a:~a\" = { path = \"~a/share/rust-source\" }~%"
                        crate version path)))))))
      inputs)
     (close-port port))
@@ -63,19 +63,22 @@
 (define* (build #:key (cargo-build-flags '("--release" "--frozen"))
                 #:allow-other-keys)
   "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)
   "Run tests for a given Cargo package."
-  (when tests?
-    (zero? (system* "cargo" "test"))))
+  (if (and tests? (file-exists? "Cargo.lock"))
+      (zero? (system* "cargo" "test"))
+      #t))
 
 (define* (install #:key inputs outputs #:allow-other-keys)
   "Install a given Cargo package."
   (let* ((out (assoc-ref outputs "out"))
          (src (assoc-ref inputs "source"))
-         (bin (string-append out "/bin"))
-         (rsrc (string-append out "/rustsrc")))
+         (rsrc (string-append (assoc-ref outputs "src")
+                              "/share/rust-source")))
     (mkdir-p rsrc)
     ;; Rust doesn't have a stable ABI yet. Because of this
     ;; Cargo doesn't have a search path for binaries yet.
@@ -87,8 +90,9 @@
     ;; When the package includes executables we install
     ;; it using cargo install. This fails when the crate
     ;; doesn't contain an executable.
-    (system* "cargo" "install" "--root" bin)
-    #t))
+    (if (file-exists? "Cargo.lock")
+        (system* "cargo" "install" "--root" out)
+        (mkdir out))))
 
 (define %standard-phases
   ;; 'configure' phase is not needed.
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 33cc610..233a20e 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -97,8 +97,8 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, 
DESCRIPTION, and LICENSE."
                               (base32
                                ,(bytevector->nix-base32-string (port-sha256 
port))))))
                    (build-system cargo-build-system)
-                   ,@(maybe-native-inputs native-inputs)
-                   ,@(maybe-inputs inputs)
+                   ,@(maybe-native-inputs native-inputs "src")
+                   ,@(maybe-inputs inputs "src")
                    (home-page ,(match home-page
                                  (() "")
                                  (_ home-page)))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index f304da2..be1980d 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -211,24 +211,26 @@ into a proper sentence and by using two spaces between 
sentences."
     (regexp-substitute/global #f "\\. \\b"
                               cleaned 'pre ".  " 'post)))
 
-(define (package-names->package-inputs names)
+(define* (package-names->package-inputs names #:optional (output #f))
   (map (lambda (input)
-         (list input (list 'unquote (string->symbol input))))
+         (cons* input (list 'unquote (string->symbol input))
+                            (or (and output (list output))
+                                '())))
        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
 package definition."
-  (match (package-names->package-inputs package-names)
+  (match (package-names->package-inputs package-names output)
     (()
      '())
     ((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
 package definition."
-  (match (package-names->package-inputs package-names)
+  (match (package-names->package-inputs package-names output)
     (()
      '())
     ((package-inputs ...)
diff --git a/tests/crate.scm b/tests/crate.scm
index 6f6fc2b..0bb344b 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -91,7 +91,7 @@
          ('build-system 'cargo-build-system)
          ('inputs
           ('quasiquote
-           (("rust-bar" ('unquote 'rust-bar)))))
+           (("rust-bar" ('unquote 'rust-bar) "src"))))
          ('home-page "http://example.com";)
          ('synopsis "summary")
          ('description "summary")