From eddd4077a5292052d95443078ee4db9f34f2f0e2 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 12 Nov 2013 00:10:10 +0100
Subject: store: Add 'log-file' procedure.

* guix/store.scm (log-file): New procedure.
* tests/store.scm ("log-file, derivation", "log-file, output file
  name"): New tests.
---
 tests/store.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'tests/store.scm')

diff --git a/tests/store.scm b/tests/store.scm
index b5e0cb0eab..430027c33b 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -140,6 +140,33 @@
          (equal? (valid-derivers %store o)
                  (list (derivation-file-name d))))))
 
+(test-assert "log-file, derivation"
+  (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s (add-to-store %store "bash" #t "sha256"
+                          (search-bootstrap-binary "bash"
+                                                   (%current-system))))
+         (d (derivation %store "the-thing"
+                        s `("-e" ,b)
+                        #:env-vars `(("foo" . ,(random-text)))
+                        #:inputs `((,b) (,s)))))
+    (and (build-derivations %store (list d))
+         (file-exists? (pk (log-file %store (derivation-file-name d)))))))
+
+(test-assert "log-file, output file name"
+  (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s (add-to-store %store "bash" #t "sha256"
+                          (search-bootstrap-binary "bash"
+                                                   (%current-system))))
+         (d (derivation %store "the-thing"
+                        s `("-e" ,b)
+                        #:env-vars `(("foo" . ,(random-text)))
+                        #:inputs `((,b) (,s))))
+         (o (derivation->output-path d)))
+    (and (build-derivations %store (list d))
+         (file-exists? (pk (log-file %store o)))
+         (string=? (log-file %store (derivation-file-name d))
+                   (log-file %store o)))))
+
 (test-assert "no substitutes"
   (let* ((s  (open-connection))
          (d1 (package-derivation s %bootstrap-guile (%current-system)))
-- 
cgit 1.4.1


From 9336e5b5e7b05e636b147aba2c97357620711c2a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 12 Nov 2013 23:36:29 +0100
Subject: store: Make 'direct-store-path?' public.

* guix/store.scm (direct-store-path?): New procedure.
* guix/derivations.scm (derivation)[direct-store-path?]: Remove.
* tests/store.scm ("direct-store-path?"): New test.
---
 guix/derivations.scm | 9 ---------
 guix/store.scm       | 9 +++++++++
 tests/store.scm      | 9 +++++++++
 3 files changed, 18 insertions(+), 9 deletions(-)

(limited to 'tests/store.scm')

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 011f4b778b..b33e835556 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -541,15 +541,6 @@ advance, such as a file download.
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs.  In that case, the reference graph of each store path is exported in
 the build environment in the corresponding file, in a simple text format."
-  (define direct-store-path?
-    (let ((len (+ 1 (string-length (%store-prefix)))))
-      (lambda (p)
-        ;; Return #t if P is a store path, and not a sub-directory of a
-        ;; store path.  This predicate is needed because files *under* a
-        ;; store path are not valid inputs.
-        (and (store-path? p)
-             (not (string-index (substring p len) #\/))))))
-
   (define (add-output-paths drv)
     ;; Return DRV with an actual store path for each of its output and the
     ;; corresponding environment variable.
diff --git a/guix/store.scm b/guix/store.scm
index 290118d74b..2821cacdcc 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -85,6 +85,7 @@
 
             %store-prefix
             store-path?
+            direct-store-path?
             derivation-path?
             store-path-package-name
             store-path-hash-part
@@ -640,6 +641,14 @@ collected, and the number of bytes freed."
   ;; `isStorePath' in Nix does something similar.
   (string-prefix? (%store-prefix) path))
 
+(define (direct-store-path? path)
+  "Return #t if PATH is a store path, and not a sub-directory of a store path.
+This predicate is sometimes needed because files *under* a store path are not
+valid inputs."
+  (and (store-path? path)
+       (let ((len (+ 1 (string-length (%store-prefix)))))
+         (not (string-index (substring path len) #\/)))))
+
 (define (derivation-path? path)
   "Return #t if PATH is a derivation path."
   (and (store-path? path) (string-suffix? ".drv" path)))
diff --git a/tests/store.scm b/tests/store.scm
index 430027c33b..741803884d 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -65,6 +65,15 @@
    (string-append (%store-prefix)
                   "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
 
+(test-assert "direct-store-path?"
+  (and (direct-store-path?
+        (string-append (%store-prefix)
+                       "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
+       (not (direct-store-path?
+             (string-append
+              (%store-prefix)
+              "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))))
+
 (test-skip (if %store 0 10))
 
 (test-assert "dead-paths"
-- 
cgit 1.4.1