aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/gexp.scm7
-rw-r--r--tests/gexp.scm20
2 files changed, 23 insertions, 4 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 88cabc8ed5..febd72a904 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
@@ -388,8 +388,9 @@ This is the declarative counterpart of 'gexp->derivation'."
(mlet %store-monad ((guile (lower-object guile system
#:target target)))
(apply gexp->derivation name gexp #:guile-for-build guile
- options))
- (apply gexp->derivation name gexp options)))))
+ #:system system #:target target options))
+ (apply gexp->derivation name gexp
+ #:system system #:target target options)))))
(define-record-type <program-file>
(%program-file name gexp guile path)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 35a76a496e..c4b437cd49 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1171,6 +1171,24 @@
(string=? (readlink (string-append comp "/text"))
text)))))))
+(test-equal "lower-object, computed-file, #:system"
+ '("mips64el-linux")
+ (run-with-store %store
+ (let* ((exp #~(symlink #$coreutils #$output))
+ (computed (computed-file "computed" exp
+ #:guile %bootstrap-guile)))
+ ;; Make sure that the SYSTEM argument to 'lower-object' is honored.
+ (mlet* %store-monad ((drv (lower-object computed "mips64el-linux"))
+ (refs (references* (derivation-file-name drv))))
+ (return (delete-duplicates
+ (filter-map (lambda (file)
+ (and (string-suffix? ".drv" file)
+ (let ((drv (read-derivation-from-file
+ file)))
+ (derivation-system drv))))
+ (cons (derivation-file-name drv)
+ refs))))))))
+
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))