transformations: Git source transformations honour RECURSIVE?.

* guix/transformations.scm (package-git-url+recursive?): New variable.
(package-git-url): Remove variable.
(evaluate-git-replacement-specs): Use package-git-url+recursive?.
(transform-package-source-branch, transform-package-source-commit, transform-package-source-git-url): Update
according to changes above.
* doc/guix.texi (Package Transformation Options): Update documentation.
* tests/transformations.scm: Update tests. Add tests for RECURSIVE?
inheritance with WITH-COMMIT and WITH-SOURCE.

Change-Id: Id6a5e6957a9955c8173b06b3e14f2986c6dfc4bc
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

3 files changed, 88 insertions, 23 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 7f796c5fc9..c4207f91bc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13586,9 +13586,11 @@ the risks of incompatibility but cannot entirely eliminate them.  Choose
 @item --with-git-url=@var{package}=@var{url}
 @cindex Git, using the latest commit
 @cindex latest commit, building
-Build @var{package} from the latest commit of the @code{master} branch of the
-Git repository at @var{url}.  Git sub-modules of the repository are fetched,
-recursively.
+Build @var{package} from the latest commit of the @code{master} branch
+of the Git repository at @var{url}.  Git sub-modules of the repository
+are fetched, recursively, if @var{package} @code{source} is not a Git
+repository, otherwise it depends on the inherited value of
+@code{recursive?}.
 
 For example, the following command builds the NumPy Python library against the
 latest commit of the master branch of Python itself:
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 2887d91a34..19a1cba206 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -29,8 +29,13 @@
   #:use-module (guix profiles)
   #:use-module (guix diagnostics)
   #:autoload   (guix download) (download-to-store)
-  #:autoload   (guix git-download) (git-reference? git-reference-url)
-  #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
+  #:autoload   (guix git-download) (git-reference?
+                                    git-reference-url
+                                    git-reference-recursive?)
+  #:autoload   (guix git) (git-checkout
+                           git-checkout?
+                           git-checkout-url
+                           git-checkout-recursive?)
   #:autoload   (guix upstream) (upstream-source
                                 package-latest-release
                                 preferred-upstream-source
@@ -234,15 +239,18 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
 (define %not-equal
   (char-set-complement (char-set #\=)))
 
-(define (package-git-url package)
-  "Return the URL of the Git repository for package, or raise an error if
-the source of PACKAGE is not fetched from a Git repository."
+(define (package-git-url+recursive? package)
+  "Return two values: the URL of the Git repository for package and a boolean
+indicating if the repository has to be recursively cloned, or raise an error if the
+source of PACKAGE is not fetched from a Git repository."
   (let ((source (package-source package)))
     (cond ((and (origin? source)
                 (git-reference? (origin-uri source)))
-           (git-reference-url (origin-uri source)))
+           (values (git-reference-url (origin-uri source))
+                   (git-reference-recursive? (origin-uri source))))
           ((git-checkout? source)
-           (git-checkout-url source))
+           (values (git-checkout-url source)
+                   (git-checkout-recursive? source)))
           (else
            (raise
             (formatted-message (G_ "the source of ~a is not a Git reference")
@@ -257,9 +265,9 @@ syntax, or if a package it refers to could not be found."
          (match (string-tokenize spec %not-equal)
            ((spec branch-or-commit)
             (define (replace old)
-              (let* ((source (package-source old))
-                     (url    (package-git-url old)))
-                (proc old url branch-or-commit)))
+              (let* ((source         (package-source old))
+                     (url recursive? (package-git-url+recursive? old)))
+                (proc old url branch-or-commit recursive?)))
 
             (cons spec replace))
            (_
@@ -273,7 +281,7 @@ syntax, or if a package it refers to could not be found."
 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
 strings like \"guile-next=stable-3.0\" meaning that packages are built using
 'guile-next' from the latest commit on its 'stable-3.0' branch."
-  (define (replace old url branch)
+  (define (replace old url branch recursive?)
     (package
       (inherit old)
       (version (string-append "git." (string-map (match-lambda
@@ -281,7 +289,7 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
                                                    (chr chr))
                                                  branch)))
       (source (git-checkout (url url) (branch branch)
-                            (recursive? #t)))))
+                            (recursive? recursive?)))))
 
   (let* ((replacements (evaluate-git-replacement-specs replacement-specs
                                                        replace))
@@ -315,12 +323,12 @@ on the given COMMIT."
 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
 strings like \"guile-next=cabba9e\" meaning that packages are built using
 'guile-next' from commit 'cabba9e'."
-  (define (replace old url commit)
+  (define (replace old url commit recursive?)
     (package
       (inherit old)
       (version (commit->version-string commit))
       (source (git-checkout (url url) (commit commit)
-                            (recursive? #t)))))
+                            (recursive? recursive?)))))
 
   (let* ((replacements (evaluate-git-replacement-specs replacement-specs
                                                        replace))
@@ -341,10 +349,19 @@ a checkout of the Git repository at the given URL."
              ((spec url)
               (cons spec
                     (lambda (old)
-                      (package
-                        (inherit old)
-                        (source (git-checkout (url url)
-                                              (recursive? #t)))))))
+                      ;; Propagate RECURSIVE? from the package source when it is a
+                      ;; git-checkout or a git-reference, keeping TRUE as default in
+                      ;; other cases.
+                      (let* ((uri (and (origin? (package-source old))
+                                       (origin-uri (package-source old))))
+                             (recursive? (if (or (git-checkout? uri)
+                                                 (git-reference? uri))
+                                             (package-git-url+recursive? old)
+                                             #t)))
+                        (package
+                          (inherit old)
+                          (source (git-checkout (url url)
+                                                (recursive? recursive?))))))))
              (_
               (raise
                (formatted-message
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 5285d98f17..9f5aacc41b 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -217,6 +217,28 @@
 
 (test-equal "options->transformation, with-branch"
   (git-checkout (url "https://example.org")
+                (branch "devel"))
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (source (origin
+                                            (method git-fetch)
+                                            (uri (git-reference
+                                                  (url "https://example.org")
+                                                  (commit "cabba9e")))
+                                            (sha256 #f)))))))))
+         (t (options->transformation '((with-branch . "chbouib=devel")))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name grep))
+                   (string=? (package-name dep2) "chbouib")
+                   (package-source dep2))))))))
+
+(test-equal "options->transformation, with-branch, recursive? inheritance"
+  (git-checkout (url "https://example.org")
                 (branch "devel")
                 (recursive? #t))
   (let* ((p (dummy-package "guix.scm"
@@ -226,7 +248,8 @@
                                             (method git-fetch)
                                             (uri (git-reference
                                                   (url "https://example.org")
-                                                  (commit "cabba9e")))
+                                                  (commit "cabba9e")
+                                                  (recursive? #t)))
                                             (sha256 #f)))))))))
          (t (options->transformation '((with-branch . "chbouib=devel")))))
     (let ((new (t p)))
@@ -240,6 +263,28 @@
 
 (test-equal "options->transformation, with-commit"
   (git-checkout (url "https://example.org")
+                (commit "abcdef"))
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (source (origin
+                                            (method git-fetch)
+                                            (uri (git-reference
+                                                  (url "https://example.org")
+                                                  (commit "cabba9e")))
+                                            (sha256 #f)))))))))
+         (t (options->transformation '((with-commit . "chbouib=abcdef")))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name grep))
+                   (string=? (package-name dep2) "chbouib")
+                   (package-source dep2))))))))
+
+(test-equal "options->transformation, with-commit, recursive? inheritance"
+  (git-checkout (url "https://example.org")
                 (commit "abcdef")
                 (recursive? #t))
   (let* ((p (dummy-package "guix.scm"
@@ -249,7 +294,8 @@
                                             (method git-fetch)
                                             (uri (git-reference
                                                   (url "https://example.org")
-                                                  (commit "cabba9e")))
+                                                  (commit "cabba9e")
+                                                  (recursive? #t)))
                                             (sha256 #f)))))))))
          (t (options->transformation '((with-commit . "chbouib=abcdef")))))
     (let ((new (t p)))