diff options
-rw-r--r-- | guix/packages.scm | 9 | ||||
-rw-r--r-- | tests/packages.scm | 23 |
2 files changed, 28 insertions, 4 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 76e01f3f12..b397a24678 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -229,11 +229,14 @@ corresponds to the arguments expected by `set-path-environment-variable'." (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))))) diff --git a/tests/packages.scm b/tests/packages.scm index 2a87f3f15d..88d21e0578 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -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 @@ #: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 @@ (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) |