mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
channels: 'build-from-source' restores '%guile-for-build'.
Not restoring it would cause problems when running: guix time-machine --commit=6298c3ffd9654d3231a6f25390b056483e8f407c or similar because the target Guix would be built with 2.2, and then we'd erroneously go on and attempt build the profile with 2.2. This would fail because profile dependencies such as "guile-gdbm-ffi" now target 3.0. * guix/channels.scm (call-with-guile): New procedure. (with-guile): New macro. (build-from-source): Use it instead of calling 'set-guile-for-build' just once. This ensures that '%guile-for-build' is restored afterwards.
This commit is contained in:
parent
04191985cc
commit
9db8836916
1 changed files with 20 additions and 4 deletions
|
@ -347,6 +347,21 @@ (define* (guile-for-source source #:optional (quirks %quirks))
|
||||||
(((predicate . guile) rest ...)
|
(((predicate . guile) rest ...)
|
||||||
(if (predicate source) (guile) (loop rest))))))
|
(if (predicate source) (guile) (loop rest))))))
|
||||||
|
|
||||||
|
(define (call-with-guile guile thunk)
|
||||||
|
(lambda (store)
|
||||||
|
(values (parameterize ((%guile-for-build
|
||||||
|
(if guile
|
||||||
|
(package-derivation store guile)
|
||||||
|
(%guile-for-build))))
|
||||||
|
(run-with-store store (thunk)))
|
||||||
|
store)))
|
||||||
|
|
||||||
|
(define-syntax-rule (with-guile guile exp ...)
|
||||||
|
"Set GUILE as the '%guile-for-build' parameter for the dynamic extent of
|
||||||
|
EXP, a series of monadic expressions."
|
||||||
|
(call-with-guile guile (lambda ()
|
||||||
|
(mbegin %store-monad exp ...))))
|
||||||
|
|
||||||
(define (with-trivial-build-handler mvalue)
|
(define (with-trivial-build-handler mvalue)
|
||||||
"Run MVALUE, a monadic value, with a \"trivial\" build handler installed
|
"Run MVALUE, a monadic value, with a \"trivial\" build handler installed
|
||||||
that unconditionally resumes the continuation."
|
that unconditionally resumes the continuation."
|
||||||
|
@ -385,10 +400,7 @@ (define script
|
||||||
;; Note: BUILD can return #f if it does not support %PULL-VERSION. In
|
;; Note: BUILD can return #f if it does not support %PULL-VERSION. In
|
||||||
;; the future we'll fall back to a previous version of the protocol
|
;; the future we'll fall back to a previous version of the protocol
|
||||||
;; when that happens.
|
;; when that happens.
|
||||||
(mbegin %store-monad
|
(with-guile guile
|
||||||
(mwhen guile
|
|
||||||
(set-guile-for-build guile))
|
|
||||||
|
|
||||||
;; BUILD is usually quite costly. Install a "trivial" build handler
|
;; BUILD is usually quite costly. Install a "trivial" build handler
|
||||||
;; so we don't bounce an outer build-accumulator handler that could
|
;; so we don't bounce an outer build-accumulator handler that could
|
||||||
;; cause us to redo half of the BUILD computation several times just
|
;; cause us to redo half of the BUILD computation several times just
|
||||||
|
@ -750,3 +762,7 @@ (define* (channel-news-for-commit channel new #:optional old)
|
||||||
(if (= GIT_ENOTFOUND (git-error-code error))
|
(if (= GIT_ENOTFOUND (git-error-code error))
|
||||||
'()
|
'()
|
||||||
(apply throw key error rest)))))
|
(apply throw key error rest)))))
|
||||||
|
|
||||||
|
;;; Local Variables:
|
||||||
|
;;; eval: (put 'with-guile 'scheme-indent-function 1)
|
||||||
|
;;; End:
|
||||||
|
|
Loading…
Reference in a new issue