From 98a7b528d61cfca3f8bfc827cf94f4716ab75abd Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 12 Feb 2016 18:59:11 +0100
Subject: store: Add monadic access to '%current-system'.

* guix/store.scm (current-system, set-current-system): New procedures.
* tests/store.scm ("current-system"): New test.
---
 tests/store.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

(limited to 'tests/store.scm')

diff --git a/tests/store.scm b/tests/store.scm
index 394c06bc0f..9d651ce5a9 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -837,6 +837,15 @@
          (file (add %store "foo" "Lowered.")))
     (call-with-input-file file get-string-all)))
 
+(test-equal "current-system"
+  "bar"
+  (parameterize ((%current-system "frob"))
+    (run-with-store %store
+      (mbegin %store-monad
+        (set-current-system "bar")
+        (current-system))
+      #:system "foo")))
+
 (test-assert "query-path-info"
   (let* ((ref (add-text-to-store %store "ref" "foo"))
          (item (add-text-to-store %store "item" "bar" (list ref)))
-- 
cgit 1.4.1


From 22572d56cb3da5b176b5b5697d4e8e71067eab74 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 26 Feb 2016 23:14:28 +0100
Subject: store: 'path-info-deriver' is #f when there is no deriver.

* guix/store.scm (read-path-info): Use #f when we get the empty string
for DERIVER.
* guix/scripts/publish.scm (narinfo-string): Adjust accordingly.
* tests/store.scm ("path-info-deriver"): New test.
---
 guix/scripts/publish.scm |  2 +-
 guix/store.scm           |  6 ++++--
 tests/store.scm          | 15 +++++++++++++++
 3 files changed, 20 insertions(+), 3 deletions(-)

(limited to 'tests/store.scm')

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 5306afcf07..46292131d7 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -164,7 +164,7 @@ References: ~a~%"
                              store-path url hash size references))
          ;; Do not render a "Deriver" or "System" line if we are rendering
          ;; info for a derivation.
-         (info       (if (string-null? deriver)
+         (info       (if (not deriver)
                          base-info
                          (catch 'system-error
                            (lambda ()
diff --git a/guix/store.scm b/guix/store.scm
index 3d6cff4c21..8746d3c2d6 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -242,14 +242,16 @@
 (define-record-type <path-info>
   (path-info deriver hash references registration-time nar-size)
   path-info?
-  (deriver path-info-deriver)
+  (deriver path-info-deriver)                     ;string | #f
   (hash path-info-hash)
   (references path-info-references)
   (registration-time path-info-registration-time)
   (nar-size path-info-nar-size))
 
 (define (read-path-info p)
-  (let ((deriver  (read-store-path p))
+  (let ((deriver  (match (read-store-path p)
+                    ("" #f)
+                    (x  x)))
         (hash     (base16-string->bytevector (read-string p)))
         (refs     (read-store-path-list p))
         (registration-time (read-int p))
diff --git a/tests/store.scm b/tests/store.scm
index 9d651ce5a9..de070eab23 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -856,6 +856,21 @@
                   (string->utf8
                    (call-with-output-string (cut write-file item <>))))))))
 
+(test-assert "path-info-deriver"
+  (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))
+         (not (path-info-deriver (query-path-info %store b)))
+         (string=? (derivation-file-name d)
+                   (path-info-deriver (query-path-info %store o))))))
+
 (test-end "store")
 
 
-- 
cgit 1.4.1