mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-07 11:29:59 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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 ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -118,6 +118,8 @@
store-lower store-lower
run-with-store run-with-store
%guile-for-build %guile-for-build
current-system
set-current-system
text-file text-file
interned-file interned-file
@ -1040,6 +1042,18 @@ permission bits are kept."
(define set-build-options* (define set-build-options*
(store-lift 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 (define %guile-for-build
;; The derivation of the Guile to be used within the build environment, ;; The derivation of the Guile to be used within the build environment,
;; when using 'gexp->derivation' and co. ;; when using 'gexp->derivation' and co.

11
tests/store.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -837,6 +837,15 @@
(file (add %store "foo" "Lowered."))) (file (add %store "foo" "Lowered.")))
(call-with-input-file file get-string-all))) (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" (test-assert "query-path-info"
(let* ((ref (add-text-to-store %store "ref" "foo")) (let* ((ref (add-text-to-store %store "ref" "foo"))
(item (add-text-to-store %store "item" "bar" (list ref))) (item (add-text-to-store %store "item" "bar" (list ref)))