From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 15 Jun 2016 08:38:46 +0000 (+0200)
Subject: packages: The 'source' can be any lowerable object.
X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/commitdiff_plain/da675305ddf2ba574e309e515d18ae1f778297be

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.
---

diff --git a/doc/guix.texi b/doc/guix.texi
index 0a30b52fca..18a1960cf7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2503,8 +2503,12 @@ The name of the package, as a string.
 The version of the package, as a string.
 
 @item @code{source}
-An origin object telling how the source code for the package should be
-acquired (@pxref{origin Reference}).
+An object telling how the source code for the package should be
+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}
 The build system that should be used to build the package (@pxref{Build
diff --git a/guix/packages.scm b/guix/packages.scm
index 1e816179a6..05a632cf05 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -792,7 +792,7 @@ information in exceptions."
      ;; store path, it needs to be added anyway, so it can be used as a
      ;; source.
      (list name (intern file)))
-    (((? string? name) (? origin? source))
+    (((? string? name) (? struct? source))
      (list name (package-source-derivation store source system)))
     (x
      (raise (condition (&package-input-error
@@ -1161,12 +1161,12 @@ cross-compilation target triplet."
   (origin->derivation origin system))
 
 (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)))
       "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
-interned file name (if SOURCE is outside of the store) or SOURCE itself (if
-SOURCE is already a store item.)"
+a file name or any object handled by 'lower-object', such as an <origin>.
+When SOURCE is a file name, return either the interned file name (if SOURCE is
+outside of the store) or SOURCE itself (if SOURCE is already a store item.)"
       (match source
         ((and (? string?) (? direct-store-path?) file)
          file)
diff --git a/tests/packages.scm b/tests/packages.scm
index 94e8150b75..d3f432ada2 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -21,6 +21,7 @@
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix grafts)
+  #:use-module ((guix gexp) #:select (local-file local-file-file))
   #:use-module ((guix utils)
                 ;; Rename the 'location' binding to allow proper syntax
                 ;; matching when setting the 'location' field of a package.
@@ -295,6 +296,20 @@
     (and (direct-store-path? 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))
 (test-equal "package-source-derivation, snippet"
   "OK"