[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#32174] [PATCH 4/6] gexp: 'imported-files' no longer creates a deriv
|
From: |
Ludovic Courtès |
|
Subject: |
[bug#32174] [PATCH 4/6] gexp: 'imported-files' no longer creates a derivation by default. |
|
Date: |
Mon, 16 Jul 2018 15:33:25 +0200 |
* guix/gexp.scm (gexp->derivation): Add #:import-creates-derivation?.
Pass #:derivation? to 'imported-modules' and 'compiled-modules'. In -L
argument, check whether MODULES is a derivation.
(%not-slash): New variable.
(file-mapping->tree): New procedure.
(imported-files): Rename to...
(imported-files/derivation): ... this.
(imported-files): New procedure. Rewrite in terms of
'interned-file-tree' when possible; add #:derivation? parameter.
(imported-modules, compiled-modules): Add #:derivation? parameter and
pass it to 'imported-files'.
* guix/packages.scm (patch-and-repack): Pass
#:import-creates-derivation? to 'gexp->derivation'.
* tests/gexp.scm ("imported-files"): Adjust to no longer expect a
derivation.
---
guix/gexp.scm | 115 ++++++++++++++++++++++++++++++++++++++++------
guix/packages.scm | 3 ++
tests/gexp.scm | 20 ++++----
3 files changed, 114 insertions(+), 24 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 3414b81dc..19d90f5ee 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -601,6 +601,12 @@ names and file names suitable for the #:allowed-references
argument to
allowed-references disallowed-references
leaked-env-vars
local-build? (substitutable? #t)
+
+ ;; TODO: This parameter is transitional; it's here
+ ;; to avoid a full rebuild. Remove it on the next
+ ;; rebuild cycle.
+ import-creates-derivation?
+
deprecation-warnings
(script-name (string-append name "-builder")))
"Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
@@ -695,6 +701,8 @@ The other arguments are as for 'derivation'."
extensions))
(modules (if (pair? %modules)
(imported-modules %modules
+ #:derivation?
+
import-creates-derivation?
#:system system
#:module-path
module-path
#:guile guile-for-build
@@ -703,6 +711,8 @@ The other arguments are as for 'derivation'."
(return #f)))
(compiled (if (pair? %modules)
(compiled-modules %modules
+ #:derivation?
+
import-creates-derivation?
#:system system
#:module-path
module-path
#:extensions extensions
@@ -735,7 +745,9 @@ The other arguments are as for 'derivation'."
"/bin/guile")
`("--no-auto-compile"
,@(if (pair? %modules)
- `("-L" ,(derivation->output-path modules)
+ `("-L" ,(if (derivation? modules)
+ (derivation->output-path modules)
+ modules)
"-C" ,(derivation->output-path compiled))
'())
,@(append-map extension-flags exts)
@@ -1013,6 +1025,49 @@ execution environment."
;;; Module handling.
;;;
+(define %not-slash
+ (char-set-complement (char-set #\/)))
+
+(define (file-mapping->tree mapping)
+ "Convert MAPPING, an alist like:
+
+ ((\"guix/build/utils.scm\" . \"…/utils.scm\"))
+
+to a tree suitable for 'interned-file-tree'."
+ (let ((mapping (map (match-lambda
+ ((destination . source)
+ (cons (string-tokenize destination
+ %not-slash)
+ source)))
+ mapping)))
+ (fold (lambda (pair result)
+ (match pair
+ ((destination . source)
+ (let loop ((destination destination)
+ (result result))
+ (match destination
+ ((file)
+ (let* ((mode (stat:mode (stat source)))
+ (type (if (zero? (logand mode #o100))
+ 'regular
+ 'executable)))
+ (alist-cons file
+ `(,type (file ,source))
+ result)))
+ ((file rest ...)
+ (let ((directory (assoc-ref result file)))
+ (alist-cons file
+ `(directory
+ ,@(loop rest
+ (match directory
+ (('directory . entries) entries)
+ (#f '()))))
+ (if directory
+ (alist-delete file result)
+ result)))))))))
+ '()
+ mapping)))
+
(define %utils-module
;; This file provides 'mkdir-p', needed to implement 'imported-files' and
;; other primitives below. Note: We give the file name relative to this
@@ -1021,18 +1076,18 @@ execution environment."
(local-file "build/utils.scm"
"build-utils.scm"))
-(define* (imported-files files
- #:key (name "file-import")
- (system (%current-system))
- (guile (%guile-for-build))
+(define* (imported-files/derivation files
+ #:key (name "file-import")
+ (system (%current-system))
+ (guile (%guile-for-build))
- ;; XXX: The only reason we have
- ;; #:deprecation-warnings is because (guix build
- ;; utils), which we use here, relies on _IO*, which
- ;; is deprecated in 2.2. On the next full-rebuild
- ;; cycle, we should disable such warnings
- ;; unconditionally.
- (deprecation-warnings #f))
+ ;; XXX: The only reason we have
+ ;; #:deprecation-warnings is because (guix
+ ;; build utils), which we use here, relies
+ ;; on _IO*, which is deprecated in 2.2. On
+ ;; the next full-rebuild cycle, we should
+ ;; disable such warnings unconditionally.
+ (deprecation-warnings #f))
"Return a derivation that imports FILES into STORE. FILES must be a list
of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the
resulting store path. FILE can be either a file name, or a file-like object,
@@ -1081,8 +1136,38 @@ as returned by 'local-file' for example."
(else
'())))))
+(define* (imported-files files
+ #:key (name "file-import")
+
+ ;; TODO: Remove this parameter on the next rebuild
+ ;; cycle.
+ (derivation? #f)
+
+ ;; The following parameters make sense when creating
+ ;; an actual derivation.
+ (system (%current-system))
+ (guile (%guile-for-build))
+ (deprecation-warnings #f))
+ "Import FILES into the store and return the resulting derivation or store
+file name (a derivation is created if and only if some elements of FILES are
+file-like objects and not local file names.) FILES must be a list
+of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the
+resulting store path. FILE can be either a file name, or a file-like object,
+as returned by 'local-file' for example."
+ (if (or derivation?
+ (any (match-lambda
+ ((_ . (? struct? source)) #t)
+ (_ #f))
+ files))
+ (imported-files/derivation files #:name name
+ #:system system #:guile guile
+ #:deprecation-warnings deprecation-warnings)
+ (interned-file-tree `(,name directory
+ ,@(file-mapping->tree files)))))
+
(define* (imported-modules modules
#:key (name "module-import")
+ (derivation? #f) ;TODO: remove on next rebuild
(system (%current-system))
(guile (%guile-for-build))
(module-path %load-path)
@@ -1106,12 +1191,15 @@ last one is created from the given <scheme-file>
object."
(let ((f (module->source-file-name module)))
(cons f (search-path* module-path f)))))
modules)))
- (imported-files files #:name name #:system system
+ (imported-files files #:name name
+ #:derivation? derivation?
+ #:system system
#:guile guile
#:deprecation-warnings deprecation-warnings)))
(define* (compiled-modules modules
#:key (name "module-import-compiled")
+ (derivation? #f) ;TODO: remove on next rebuild
(system (%current-system))
(guile (%guile-for-build))
(module-path %load-path)
@@ -1131,6 +1219,7 @@ they can refer to each other."
(not (equal? module-path %load-path))))
(mlet %store-monad ((modules (imported-modules modules
+ #:derivation? derivation?
#:system system
#:guile guile
#:module-path
diff --git a/guix/packages.scm b/guix/packages.scm
index c762fa7c3..a220b9c47 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -646,6 +646,9 @@ specifies modules in scope when evaluating SNIPPET."
(let ((name (tarxz-name original-file-name)))
(gexp->derivation name build
+ ;; TODO: Remove this on the next rebuild cycle.
+ #:import-creates-derivation? #t
+
#:graft? #f
#:system system
#:deprecation-warnings #t ;to avoid a rebuild
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 83fe81154..2a43b739c 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -635,18 +635,16 @@
"guix/derivations.scm"))
("p/q" . ,(search-path %load-path "guix.scm"))
("p/z" . ,(search-path %load-path "guix/store.scm"))))
- (drv (imported-files files)))
+ (dir (imported-files files)))
(mbegin %store-monad
- (built-derivations (list drv))
- (let ((dir (derivation->output-path drv)))
- (return
- (every (match-lambda
- ((path . source)
- (equal? (call-with-input-file (string-append dir "/" path)
- get-bytevector-all)
- (call-with-input-file source
- get-bytevector-all))))
- files))))))
+ (return
+ (every (match-lambda
+ ((path . source)
+ (equal? (call-with-input-file (string-append dir "/" path)
+ get-bytevector-all)
+ (call-with-input-file source
+ get-bytevector-all))))
+ files)))))
(test-assertm "imported-files with file-like objects"
(mlet* %store-monad ((plain -> (plain-file "foo" "bar!"))
--
2.18.0