packages: The 'source' can be any lowerable object.

* guix/packages.scm (expand-input): Use 'struct?' instead of 'origin?'
when matching SOURCE.
(package-source-derivation): Use 'lower-object' instead of
'origin->derivation'.
* tests/packages.scm ("package-source-derivation, local-file"): New
test.
* doc/guix.texi (package Reference): Update 'source' documentation
accordingly.
This commit is contained in:
Ludovic Courtès 2016-06-15 10:38:46 +02:00
parent 789510640d
commit da675305dd
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 26 additions and 7 deletions

View File

@ -2503,8 +2503,12 @@ The name of the package, as a string.
The version of the package, as a string. The version of the package, as a string.
@item @code{source} @item @code{source}
An origin object telling how the source code for the package should be An object telling how the source code for the package should be
acquired (@pxref{origin Reference}). acquired. Most of the time, this is an @code{origin} object, which
denotes a file fetched from the Internet (@pxref{origin Reference}). It
can also be any other ``file-like'' object such as a @code{local-file},
which denotes a file from the local file system (@pxref{G-Expressions,
@code{local-file}}).
@item @code{build-system} @item @code{build-system}
The build system that should be used to build the package (@pxref{Build The build system that should be used to build the package (@pxref{Build

View File

@ -792,7 +792,7 @@ information in exceptions."
;; store path, it needs to be added anyway, so it can be used as a ;; store path, it needs to be added anyway, so it can be used as a
;; source. ;; source.
(list name (intern file))) (list name (intern file)))
(((? string? name) (? origin? source)) (((? string? name) (? struct? source))
(list name (package-source-derivation store source system))) (list name (package-source-derivation store source system)))
(x (x
(raise (condition (&package-input-error (raise (condition (&package-input-error
@ -1161,12 +1161,12 @@ cross-compilation target triplet."
(origin->derivation origin system)) (origin->derivation origin system))
(define package-source-derivation ;somewhat deprecated (define package-source-derivation ;somewhat deprecated
(let ((lower (store-lower origin->derivation))) (let ((lower (store-lower lower-object)))
(lambda* (store source #:optional (system (%current-system))) (lambda* (store source #:optional (system (%current-system)))
"Return the derivation or file corresponding to SOURCE, which can be an "Return the derivation or file corresponding to SOURCE, which can be an
<origin> or a file name. When SOURCE is a file name, return either the a file name or any object handled by 'lower-object', such as an <origin>.
interned file name (if SOURCE is outside of the store) or SOURCE itself (if When SOURCE is a file name, return either the interned file name (if SOURCE is
SOURCE is already a store item.)" outside of the store) or SOURCE itself (if SOURCE is already a store item.)"
(match source (match source
((and (? string?) (? direct-store-path?) file) ((and (? string?) (? direct-store-path?) file)
file) file)

View File

@ -21,6 +21,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module ((guix gexp) #:select (local-file local-file-file))
#:use-module ((guix utils) #:use-module ((guix utils)
;; Rename the 'location' binding to allow proper syntax ;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package. ;; matching when setting the 'location' field of a package.
@ -295,6 +296,20 @@
(and (direct-store-path? source) (and (direct-store-path? source)
(string-suffix? "utils.scm" source)))) (string-suffix? "utils.scm" source))))
(test-assert "package-source-derivation, local-file"
(let* ((file (local-file "../guix/base32.scm"))
(package (package (inherit (dummy-package "p"))
(source file)))
(source (package-source-derivation %store
(package-source package))))
(and (store-path? source)
(string-suffix? "base32.scm" source)
(valid-path? %store source)
(equal? (call-with-input-file source get-bytevector-all)
(call-with-input-file
(search-path %load-path "guix/base32.scm")
get-bytevector-all)))))
(unless (network-reachable?) (test-skip 1)) (unless (network-reachable?) (test-skip 1))
(test-equal "package-source-derivation, snippet" (test-equal "package-source-derivation, snippet"
"OK" "OK"