~ruther/guix-local

7833db1f30d78aea3b7cb042723c2bd7d00e64ad — Ludovic Courtès 10 years ago 69792b2
gexp: 'local-file' canonicalizes its file argument.

Reported by Alex Kost <alezost@gmail.com>
at <http://lists.gnu.org/archive/html/guix-devel/2015-06/msg00235.html>.

* guix/gexp.scm (local-file): Add call to 'canonicalize-path'.
* tests/gexp.scm ("one local file, symlink"): New test.
2 files changed, 24 insertions(+), 1 deletions(-)

M guix/gexp.scm
M tests/gexp.scm
M guix/gexp.scm => guix/gexp.scm +5 -1
@@ 167,7 167,11 @@ designates a flat file and RECURSIVE? is true, its contents are added, and its
permission bits are kept.

This is the declarative counterpart of the 'interned-file' monadic procedure."
  (%local-file file name recursive?))
  ;; Canonicalize FILE so that if it's a symlink, it is resolved.  Failing to
  ;; do that, when RECURSIVE? is #t, we could end up creating a dangling
  ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would just
  ;; throw an error, both of which are inconvenient.
  (%local-file (canonicalize-path file) name recursive?))

(define-gexp-compiler (local-file-compiler (file local-file?) system target)
  ;; "Compile" FILE by adding it to the store.

M tests/gexp.scm => tests/gexp.scm +19 -0
@@ 109,6 109,25 @@
            (eq? x local)))
         (equal? `(display ,intd) (gexp->sexp* exp)))))

(test-assert "one local file, symlink"
  (let ((file (search-path %load-path "guix.scm"))
        (link (tmpnam)))
    (dynamic-wind
      (const #t)
      (lambda ()
        (symlink (canonicalize-path file) link)
        (let* ((local (local-file link "my-file" #:recursive? #f))
               (exp   (gexp (display (ungexp local))))
               (intd  (add-to-store %store "my-file" #f
                                    "sha256" file)))
          (and (gexp? exp)
               (match (gexp-inputs exp)
                 (((x "out"))
                  (eq? x local)))
               (equal? `(display ,intd) (gexp->sexp* exp)))))
      (lambda ()
        (false-if-exception (delete-file link))))))

(test-assert "one plain file"
  (let* ((file     (plain-file "hi" "Hello, world!"))
         (exp      (gexp (display (ungexp file))))