mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
gexp: 'imported-files' no longer creates a derivation by default.
* 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.
This commit is contained in:
Ludovic Courtès
parent
4d20d87b53
commit
8df2eca6b0
3 changed files with 114 additions and 24 deletions
115
guix/gexp.scm
115
guix/gexp.scm
|
|
@ -601,6 +601,12 @@ (define* (gexp->derivation name exp
|
|||
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 @@ (define (extension-flags extension)
|
|||
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 @@ (define (extension-flags extension)
|
|||
(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 @@ (define (extension-flags extension)
|
|||
"/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 @@ (define (substitute-references exp substs)
|
|||
;;; 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 @@ (define %utils-module
|
|||
(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 @@ (define build
|
|||
(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 @@ (define* (imported-modules modules
|
|||
(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 @@ (define build-utils-hack?
|
|||
(not (equal? module-path %load-path))))
|
||||
|
||||
(mlet %store-monad ((modules (imported-modules modules
|
||||
#:derivation? derivation?
|
||||
#:system system
|
||||
#:guile guile
|
||||
#:module-path
|
||||
|
|
|
|||
|
|
@ -646,6 +646,9 @@ (define (first-file directory)
|
|||
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -635,18 +635,16 @@ (define guile ,guile)
|
|||
"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!"))
|
||||
|
|
|
|||
Loading…
Reference in a new issue