mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
packages: Gracefully print packages whose 'location' is #f.
* guix/packages.scm (<package> printer): Check whether LOC is #f. * tests/packages.scm ("printer with location", "printer without location"): New tests.
This commit is contained in:
parent
9c814b828a
commit
2e1bafb034
2 changed files with 28 additions and 4 deletions
|
@ -229,11 +229,14 @@ (define-record-type* <package>
|
|||
(lambda (package port)
|
||||
(let ((loc (package-location package))
|
||||
(format simple-format))
|
||||
(format port "#<package ~a-~a ~a:~a ~a>"
|
||||
(format port "#<package ~a-~a ~a~a>"
|
||||
(package-name package)
|
||||
(package-version package)
|
||||
(location-file loc)
|
||||
(location-line loc)
|
||||
(if loc
|
||||
(format #f "~a:~a "
|
||||
(location-file loc)
|
||||
(location-line loc))
|
||||
"")
|
||||
(number->string (object-address
|
||||
package)
|
||||
16)))))
|
||||
|
|
|
@ -19,7 +19,12 @@
|
|||
(define-module (test-packages)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((guix utils)
|
||||
;; Rename the 'location' binding to allow proper syntax
|
||||
;; matching when setting the 'location' field of a package.
|
||||
#:renamer (lambda (name)
|
||||
(cond ((eq? name 'location) 'make-location)
|
||||
(else name))))
|
||||
#:use-module (guix hash)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
|
@ -34,6 +39,7 @@ (define-module (test-packages)
|
|||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;; Test the high-level packaging layer.
|
||||
|
@ -52,6 +58,21 @@ (define-syntax-rule (dummy-package name* extra-fields ...)
|
|||
(home-page #f) (license #f)
|
||||
extra-fields ...))
|
||||
|
||||
(test-assert "printer with location"
|
||||
(string-match "^#<package foo-0 foo.scm:42 [[:xdigit:]]+>$"
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write
|
||||
(dummy-package "foo"
|
||||
(location (make-location "foo.scm" 42 7))))))))
|
||||
|
||||
(test-assert "printer without location"
|
||||
(string-match "^#<package foo-0 [[:xdigit:]]+>$"
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write
|
||||
(dummy-package "foo" (location #f)))))))
|
||||
|
||||
(test-assert "package-field-location"
|
||||
(let ()
|
||||
(define (goto port line column)
|
||||
|
|
Loading…
Reference in a new issue