From 89b0c2390a53dd9b745c43c03dcb8e2915c3ba58 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 7 Mar 2021 15:22:29 +0100
Subject: packages: Call 'bag-grafts' only on the tip of the package graph.

This reinstates pre-gexp behavior where 'expand-input' would explicitly
pass #:graft? #f in recursive calls, thereby preventing redundant calls
to 'bag-grafts'.

* guix/packages.scm (expand-input): Turn into a monadic procedure.
Lower INPUT when it's a package, passing #:graft? #f.
(bag->derivation, bag->cross-derivation): Adjust accordingly.
* tests/packages.scm ("search paths"): Adjust so BUILD aborts only when
passed the package of interest.
---
 tests/packages.scm | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

(limited to 'tests')

diff --git a/tests/packages.scm b/tests/packages.scm
index 97c4c17e6e..47d10af5bc 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -858,19 +858,23 @@
 
 (test-assert "search paths"
   (let* ((p (make-prompt-tag "return-search-paths"))
+         (t (make-parameter "guile-0"))
          (s (build-system
-             (name 'raw)
-             (description "Raw build system with direct store access")
-             (lower (lambda* (name #:key source inputs system target
-                                   #:allow-other-keys)
-                      (bag
-                        (name name)
-                        (system system) (target target)
-                        (build-inputs inputs)
-                        (build
-                         (lambda* (name inputs
-                                        #:key outputs system search-paths)
-                           (abort-to-prompt p search-paths))))))))
+              (name 'raw)
+              (description "Raw build system with direct store access")
+              (lower (lambda* (name #:key source inputs system target
+                                    #:allow-other-keys)
+                       (bag
+                         (name name)
+                         (system system) (target target)
+                         (build-inputs inputs)
+                         (build
+                          (lambda* (name inputs
+                                         #:key outputs system search-paths)
+                            (if (string=? name (t))
+                                (abort-to-prompt p search-paths)
+                                (gexp->derivation name
+                                                  #~(mkdir #$output))))))))))
          (x (list (search-path-specification
                    (variable "GUILE_LOAD_PATH")
                    (files '("share/guile/site/2.0")))
@@ -895,8 +899,10 @@
                                (lambda (k search-paths)
                                  search-paths))))))
       (and (null? (collect (package-derivation %store a)))
-           (equal? x (collect (package-derivation %store b)))
-           (equal? x (collect (package-derivation %store c)))))))
+           (parameterize ((t "guile-foo-0"))
+             (equal? x (collect (package-derivation %store b))))
+           (parameterize ((t "guile-bar-0"))
+             (equal? x (collect (package-derivation %store c))))))))
 
 (test-assert "package-transitive-native-search-paths"
   (let* ((sp (lambda (name)
-- 
cgit v1.2.3