rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gexp: Add 'raw-derivation-file'. 

* guix/gexp.scm (<raw-derivation-file>): New record type.
(raw-derivation-file-compiler): New gexp compiler.
* tests/gexp.scm ("lower-gexp, raw-derivation-file")
("raw-derivation-file"): New tests.
This commit is contained in:
Ludovic Courtès 2019-12-06 23:12:49 +01:00
parent f918a8d9d8
commit d63ee94d63
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 56 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/gexp.scm
View File

@ -79,6 +79,9 @@
file-append-base
file-append-suffix
raw-derivation-file
raw-derivation-file?
load-path-expression
gexp-modules
@ -265,6 +268,29 @@ The expander specifies how an object is converted to its sexp representation."
(with-monad %store-monad
(return drv)))
;; Expand to a raw ".drv" file for the lowerable object it wraps. In other
;; words, this gives the raw ".drv" file instead of its build result.
(define-record-type <raw-derivation-file>
(raw-derivation-file obj)
raw-derivation-file?
(obj raw-derivation-file-object)) ;lowerable object
(define-gexp-compiler raw-derivation-file-compiler <raw-derivation-file>
compiler => (lambda (obj system target)
(mlet %store-monad ((obj (lower-object
(raw-derivation-file-object obj)
system #:target target)))
;; Returning the .drv file name instead of the <derivation>
;; record ensures that 'lower-gexp' will classify it as a
;; "source" and not as an "input".
(return (if (derivation? obj)
(derivation-file-name obj)
obj))))
expander => (lambda (obj lowered output)
(if (derivation? lowered)
(derivation-file-name lowered)
lowered)))
;;;
;;; File declarations.

31
tests/gexp.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -879,6 +879,17 @@
(eq? (derivation-input-derivation (lowered-gexp-guile lexp))
(%guile-for-build)))))))
(test-assertm "lower-gexp, raw-derivation-file"
(mlet* %store-monad ((thing -> (program-file "prog" #~(display "hi!")))
(exp -> #~(list #$(raw-derivation-file thing)))
(drv (lower-object thing))
(lexp (lower-gexp exp #:effective-version "2.0")))
(return (and (equal? `(list ,(derivation-file-name drv))
(lowered-gexp-sexp lexp))
(equal? (list (derivation-file-name drv))
(lowered-gexp-sources lexp))
(null? (lowered-gexp-inputs lexp))))))
(test-eq "lower-gexp, non-self-quoting input"
+
(guard (c ((gexp-input-error? c)
@ -1157,6 +1168,24 @@
(equal? `(list "foo" ,text)
(call-with-input-file out read)))))))))
(test-assertm "raw-derivation-file"
(let* ((exp #~(let ((drv #$(raw-derivation-file coreutils)))
(when (file-exists? drv)
(symlink drv #$output)))))
(mlet* %store-monad ((dep (lower-object coreutils))
(drv (gexp->derivation "drv-ref" exp))
(out -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
(mlet %store-monad ((refs (references* out)))
(return (and (member (derivation-file-name dep)
(derivation-sources drv))
(not (member (derivation-file-name dep)
(map derivation-input-path
(derivation-inputs drv))))
(equal? (readlink out) (derivation-file-name dep))
(equal? refs (list (derivation-file-name dep))))))))))
(test-assert "text-file*"
(run-with-store %store
(mlet* %store-monad