ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: 'package-field-location' returns a relative file name.

Browse source 
* 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 @@ (define (goto port line column)
(($ <location> file line column) (($ <location> file line column)
(catch 'system (catch 'system
(lambda () (lambda ()
(call-with-input-file (search-path %load-path file) ;; In general we want to keep relative file names for modules.
(lambda (port) (with-fluids ((%file-port-name-canonicalization 'relative))
(goto port line column) (call-with-input-file (search-path %load-path file)
(match (read port) (lambda (port)
(('package inits ...) (goto port line column)
(let ((field (assoc field inits))) (match (read port)
(match field (('package inits ...)
((_ value) (let ((field (assoc field inits)))
;; Put the `or' here, and not in the first argument of (match field
;; `and=>', to work around a compiler bug in 2.0.5. ((_ value)
(or (and=> (source-properties value) ;; Put the `or' here, and not in the first argument of
source-properties->location) ;; `and=>', to work around a compiler bug in 2.0.5.
(and=> (source-properties field) (or (and=> (source-properties value)
source-properties->location))) source-properties->location)
(_ (and=> (source-properties field)
#f)))) source-properties->location)))
(_ (_
#f))))) #f))))
(_
#f))))))
(lambda _ (lambda _
#f))) #f)))
(_ #f))) (_ #f)))

6
tests/packages.scm
View file

@ -81,6 +81,12 @@ (define read-at
(list version `(version ,version)))) (list version `(version ,version))))
(not (package-field-location %bootstrap-guile 'does-not-exist))))) (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" (test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a")) (let* ((a (dummy-package "a"))
(b (dummy-package "b" (b (dummy-package "b"