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

derivations: Keep the .drv file name in <derivation> objects. 

* guix/derivations.scm (<derivation>): Add 'file-name' field.
  (%read-derivation): Use (port-filename DRV-PORT) as the file name for
  the result.
  (derivation): Set the 'file-name' field in the result.
* tests/derivations.scm ("build derivation with 1 source"): Assert that
  'derivation-file-name' returns the right thing.
This commit is contained in:
Ludovic Courtès 2013-09-17 23:00:55 +02:00
parent 803704418c
commit 6a446d5680
2 changed files with 27 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
guix/derivations.scm
View File

@ -36,6 +36,7 @@
derivation-system derivation-system
derivation-builder-arguments derivation-builder-arguments
derivation-builder-environment-vars derivation-builder-environment-vars
derivation-file-name
derivation-prerequisites derivation-prerequisites
derivation-prerequisites-to-build derivation-prerequisites-to-build
@ -71,7 +72,8 @@
;;; ;;;
(define-record-type <derivation> (define-record-type <derivation>
(make-derivation outputs inputs sources system builder args env-vars) (make-derivation outputs inputs sources system builder args env-vars
file-name)
derivation? derivation?
(outputs derivation-outputs) ; list of name/<derivation-output> pairs (outputs derivation-outputs) ; list of name/<derivation-output> pairs
(inputs derivation-inputs) ; list of <derivation-input> (inputs derivation-inputs) ; list of <derivation-input>
@ -79,7 +81,8 @@
(system derivation-system) ; string (system derivation-system) ; string
(builder derivation-builder) ; store path (builder derivation-builder) ; store path
(args derivation-builder-arguments) ; list of strings (args derivation-builder-arguments) ; list of strings
(env-vars derivation-builder-environment-vars)) ; list of name/value pairs (env-vars derivation-builder-environment-vars) ; list of name/value pairs
(file-name derivation-file-name)) ; the .drv file name
(define-record-type <derivation-output> (define-record-type <derivation-output>
(make-derivation-output path hash-algo hash) (make-derivation-output path hash-algo hash)
@ -262,7 +265,8 @@ that second value is the empty list."
(make-input-drvs input-drvs) (make-input-drvs input-drvs)
input-srcs input-srcs
system builder args system builder args
(fold-right alist-cons '() var value))) (fold-right alist-cons '() var value)
(port-filename drv-port)))
(_ (_
(error "failed to parse derivation" drv-port result))))) (error "failed to parse derivation" drv-port result)))))
((? (cut eq? <> comma)) ((? (cut eq? <> comma))
@ -470,7 +474,8 @@ in SIZE bytes."
(make-derivation-input hash sub-drvs)))) (make-derivation-input hash sub-drvs))))
inputs)) inputs))
(drv (make-derivation outputs inputs sources (drv (make-derivation outputs inputs sources
system builder args env-vars))) system builder args env-vars
#f)))
;; XXX: At this point this remains faster than `port-sha256', because ;; XXX: At this point this remains faster than `port-sha256', because
;; the SHA256 port's `write' method gets called for every single ;; the SHA256 port's `write' method gets called for every single
@ -545,7 +550,8 @@ the build environment in the corresponding file, in a simple text format."
(or (and=> (assoc-ref outputs name) (or (and=> (assoc-ref outputs name)
derivation-output-path) derivation-output-path)
value)))) value))))
env-vars)))))) env-vars)
#f)))))
(define (user+system-env-vars) (define (user+system-env-vars)
;; Some options are passed to the build daemon via the env. vars of ;; Some options are passed to the build daemon via the env. vars of
@ -578,6 +584,14 @@ the build environment in the corresponding file, in a simple text format."
e e
outputs))) outputs)))
(define (set-file-name drv file)
;; Set FILE as the 'file-name' field of DRV.
(match drv
(($ <derivation> outputs inputs sources system builder
args env-vars)
(make-derivation outputs inputs sources system builder
args env-vars file))))
(let* ((outputs (map (lambda (name) (let* ((outputs (map (lambda (name)
;; Return outputs with an empty path. ;; Return outputs with an empty path.
(cons name (cons name
@ -604,17 +618,15 @@ the build environment in the corresponding file, in a simple text format."
(and (not (derivation-path? p)) (and (not (derivation-path? p))
p))) p)))
inputs) inputs)
system builder args env-vars)) system builder args env-vars #f))
(drv (add-output-paths drv-masked))) (drv (add-output-paths drv-masked)))
;; (write-derivation drv-masked (current-error-port)) (let ((file (add-text-to-store store (string-append name ".drv")
;; (newline (current-error-port)) (call-with-output-string
(values (add-text-to-store store (string-append name ".drv") (cut write-derivation drv <>))
(call-with-output-string (map derivation-input-path
(cut write-derivation drv <>)) inputs))))
(map derivation-input-path (values file (set-file-name drv file)))))
inputs))
drv)))
;;; ;;;

1
tests/derivations.scm
View File

@ -134,6 +134,7 @@
(let ((path (derivation-output-path (let ((path (derivation-output-path
(assoc-ref (derivation-outputs drv) "out")))) (assoc-ref (derivation-outputs drv) "out"))))
(and (valid-path? %store path) (and (valid-path? %store path)
(string=? (derivation-file-name drv) drv-path)
(string=? (call-with-input-file path read-line) (string=? (call-with-input-file path read-line)
"hello, world")))))) "hello, world"))))))