ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Resolve the default system at '>>=' time.

Browse source 
Partly fixes <http://bugs.gnu.org/18002>.
Reported by David Thompson <dthompson2@worcester.edu>.

* guix/gexp.scm (gexp->derivation): Change #:system to default #f.
  Use (%current-system) from within the 'mlet*'.
* tests/gexp.scm ("gexp->derivation, default system"): New test.
This commit is contained in:
Ludovic Courtès 2014-07-12 22:11:12 +02:00
parent f62435e286
commit 5d0984595c
2 changed files with 13 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
guix/gexp.scm
View file

@ -94,7 +94,7 @@ (define (lower-inputs inputs)
(define* (gexp->derivation name exp (define* (gexp->derivation name exp
#:key #:key
(system (%current-system)) system
hash hash-algo recursive? hash hash-algo recursive?
(env-vars '()) (env-vars '())
(modules '()) (modules '())
@ -114,6 +114,7 @@ (define %modules modules)
(define outputs (gexp-outputs exp)) (define outputs (gexp-outputs exp))
(mlet* %store-monad ((inputs (lower-inputs (gexp-inputs exp))) (mlet* %store-monad ((inputs (lower-inputs (gexp-inputs exp)))
(system -> (or system (%current-system)))
(sexp (gexp->sexp exp)) (sexp (gexp->sexp exp))
(builder (text-file (string-append name "-builder") (builder (text-file (string-append name "-builder")
(object->string sexp))) (object->string sexp)))

11
tests/gexp.scm
View file

@ -211,6 +211,17 @@ (define (match-input thing)
(return (string=? (readlink (string-append out "/foo")) (return (string=? (readlink (string-append out "/foo"))
guile)))) guile))))
(test-assertm "gexp->derivation, default system"
;; The default system should be the one at '>>=' time, not the one at
;; invocation time. See <http://bugs.gnu.org/18002>.
(let ((system (%current-system))
(mdrv (parameterize ((%current-system "foobar64-linux"))
(gexp->derivation "foo"
(gexp
(mkdir (ungexp output)))))))
(mlet %store-monad ((drv mdrv))
(return (string=? system (derivation-system drv))))))
(define shebang (define shebang
(string-append (derivation->output-path guile-for-build) (string-append (derivation->output-path guile-for-build)
"/bin/guile --no-auto-compile")) "/bin/guile --no-auto-compile"))