TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

store: Add monadic access to '%current-system'. 

* guix/store.scm (current-system, set-current-system): New procedures.
* tests/store.scm ("current-system"): New test.
This commit is contained in:
Ludovic Courtès 2016-02-12 18:59:11 +01:00
parent 0d0bcaa08e
commit 98a7b528d6
2 changed files with 25 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
guix/store.scm
View File

@ -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.
;;;
@ -118,6 +118,8 @@
store-lower
run-with-store
%guile-for-build
current-system
set-current-system
text-file
interned-file
@ -1040,6 +1042,18 @@ permission bits are kept."
(define set-build-options*
(store-lift set-build-options))
(define-inlinable (current-system)
;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to
;; (lift0 %current-system %store-monad), but inlinable, thus avoiding
;; closure allocation in some cases.
(lambda (state)
(values (%current-system) state)))
(define-inlinable (set-current-system system)
;; Set the %CURRENT-SYSTEM fluid at bind time.
(lambda (state)
(values (%current-system system) state)))
(define %guile-for-build
;; The derivation of the Guile to be used within the build environment,
;; when using 'gexp->derivation' and co.

11
tests/store.scm
View File

@ -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)))