From f80594cc41d7ad491f14a73d594228bacafdc871 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Nov 2013 23:44:47 +0100 Subject: packages: Suitably cope with indirect store paths as package sources. * guix/packages.scm (package-source-derivation): Don't let indirect store paths pass through. * tests/packages.scm ("package-source-derivation, indirect store path"): New test. --- tests/packages.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'tests/packages.scm') diff --git a/tests/packages.scm b/tests/packages.scm index 7c5dd9f4e1..b499c380ce 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -122,6 +122,17 @@ (package-source package)))) (string=? file source))) +(test-assert "package-source-derivation, indirect store path" + (let* ((dir (add-to-store %store "guix-build" #t "sha256" + (dirname (search-path %load-path + "guix/build/utils.scm")))) + (package (package (inherit (dummy-package "p")) + (source (string-append dir "/utils.scm")))) + (source (package-source-derivation %store + (package-source package)))) + (and (direct-store-path? source) + (string-suffix? "utils.scm" source)))) + (test-equal "package-source-derivation, snippet" "OK" (let* ((file (search-bootstrap-binary "guile-2.0.7.tar.xz" -- cgit v1.2.3 From 0b8749b7bdd68c9b28cf3d520b9a3a9cc1a5bddb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Nov 2013 23:56:07 +0100 Subject: packages: 'package-field-location' returns a relative file name. * guix/packages.scm (package-field-location): Set %FILE-PORT-NAME-CANONICALIZATION. * tests/packages.scm ("package-field-location, relative file name"): New test. --- guix/packages.scm | 38 ++++++++++++++++++++------------------ tests/packages.scm | 6 ++++++ 2 files changed, 26 insertions(+), 18 deletions(-) (limited to 'tests/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index b25cc52bba..bb7d873973 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -221,24 +221,26 @@ corresponds to the arguments expected by `set-path-environment-variable'." (($ file line column) (catch 'system (lambda () - (call-with-input-file (search-path %load-path file) - (lambda (port) - (goto port line column) - (match (read port) - (('package inits ...) - (let ((field (assoc field inits))) - (match field - ((_ value) - ;; Put the `or' here, and not in the first argument of - ;; `and=>', to work around a compiler bug in 2.0.5. - (or (and=> (source-properties value) - source-properties->location) - (and=> (source-properties field) - source-properties->location))) - (_ - #f)))) - (_ - #f))))) + ;; In general we want to keep relative file names for modules. + (with-fluids ((%file-port-name-canonicalization 'relative)) + (call-with-input-file (search-path %load-path file) + (lambda (port) + (goto port line column) + (match (read port) + (('package inits ...) + (let ((field (assoc field inits))) + (match field + ((_ value) + ;; Put the `or' here, and not in the first argument of + ;; `and=>', to work around a compiler bug in 2.0.5. + (or (and=> (source-properties value) + source-properties->location) + (and=> (source-properties field) + source-properties->location))) + (_ + #f)))) + (_ + #f)))))) (lambda _ #f))) (_ #f))) diff --git a/tests/packages.scm b/tests/packages.scm index b499c380ce..7de3fc2156 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -81,6 +81,12 @@ (list version `(version ,version)))) (not (package-field-location %bootstrap-guile 'does-not-exist))))) +;; Make sure we don't change the file name to an absolute file name. +(test-equal "package-field-location, relative file name" + (location-file (package-location %bootstrap-guile)) + (with-fluids ((%file-port-name-canonicalization 'absolute)) + (location-file (package-field-location %bootstrap-guile 'version)))) + (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) (b (dummy-package "b" -- cgit v1.2.3