nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gexp: Lowering a <computed-file> honors SYSTEM and TARGET. 

* guix/gexp.scm (computed-file-compiler): Pass #:system and #:target to
'gexp->derivation'.
* tests/gexp.scm ("lower-object, computed-file, #:system"): New test.
This commit is contained in:
Ludovic Courtès 2019-01-05 00:01:18 +01:00
parent e4be1faa43
commit 9ec154f51f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
guix/gexp.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.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 (mlet %store-monad ((guile (lower-object guile system
#:target target))) #:target target)))
(apply gexp->derivation name gexp #:guile-for-build guile (apply gexp->derivation name gexp #:guile-for-build guile
options)) #:system system #:target target options))
(apply gexp->derivation name gexp options))))) (apply gexp->derivation name gexp
#:system system #:target target options)))))
(define-record-type <program-file> (define-record-type <program-file>
(%program-file name gexp guile path) (%program-file name gexp guile path)

20
tests/gexp.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -1171,6 +1171,24 @@
(string=? (readlink (string-append comp "/text")) (string=? (readlink (string-append comp "/text"))
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?" (test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c) (guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c))) (gexp-error-invalid-input c)))