~ruther/guix-local

5d0984595c77b1b0acd84eb4684f786de5f95aff — Ludovic Courtès 11 years ago f62435e
gexp: Resolve the default system at '>>=' time.

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.
2 files changed, 13 insertions(+), 1 deletions(-)

M guix/gexp.scm
M tests/gexp.scm
M guix/gexp.scm => guix/gexp.scm +2 -1
@@ 94,7 94,7 @@ input list as a monadic value."

(define* (gexp->derivation name exp
                           #:key
                           (system (%current-system))
                           system
                           hash hash-algo recursive?
                           (env-vars '())
                           (modules '())


@@ 114,6 114,7 @@ The other arguments are as for 'derivation'."
  (define outputs (gexp-outputs exp))

  (mlet* %store-monad ((inputs   (lower-inputs (gexp-inputs exp)))
                       (system -> (or system (%current-system)))
                       (sexp     (gexp->sexp exp))
                       (builder  (text-file (string-append name "-builder")
                                            (object->string sexp)))

M tests/gexp.scm => tests/gexp.scm +11 -0
@@ 211,6 211,17 @@
    (return (string=? (readlink (string-append out "/foo"))
                      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
  (string-append (derivation->output-path guile-for-build)
                 "/bin/guile --no-auto-compile"))