TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2013-11-18 23:56:07 +01:00
parent ac5de156ae
commit 0b8749b7bd
2 changed files with 26 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
guix/packages.scm
View File

@ -221,24 +221,26 @@ corresponds to the arguments expected by `set-path-environment-variable'."
(($ <location> 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)))

6
tests/packages.scm
View File

@ -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"