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 76e01f3f12d..b397a246780 100644 --- a/guix/packages.scm +++ b/guix/packages.scm | |||
| @@ -229,11 +229,14 @@ corresponds to the arguments expected by `set-path-environment-variable'." | |||
| 229 | (lambda (package port) | 229 | (lambda (package port) |
| 230 | (let ((loc (package-location package)) | 230 | (let ((loc (package-location package)) |
| 231 | (format simple-format)) | 231 | (format simple-format)) |
| 232 | (format port "#<package ~a-~a ~a:~a ~a>" | 232 | (format port "#<package ~a-~a ~a~a>" |
| 233 | (package-name package) | 233 | (package-name package) |
| 234 | (package-version package) | 234 | (package-version package) |
| 235 | (location-file loc) | 235 | (if loc |
| 236 | (location-line loc) | 236 | (format #f "~a:~a " |
| 237 | (location-file loc) | ||
| 238 | (location-line loc)) | ||
| 239 | "") | ||
| 237 | (number->string (object-address | 240 | (number->string (object-address |
| 238 | package) | 241 | package) |
| 239 | 16))))) | 242 | 16))))) |
diff --git a/tests/packages.scm b/tests/packages.scm index 2a87f3f15d1..88d21e05784 100644 --- a/tests/packages.scm +++ b/tests/packages.scm | |||
| @@ -19,7 +19,12 @@ | |||
| 19 | (define-module (test-packages) | 19 | (define-module (test-packages) |
| 20 | #:use-module (guix tests) | 20 | #:use-module (guix tests) |
| 21 | #:use-module (guix store) | 21 | #:use-module (guix store) |
| 22 | #:use-module (guix utils) | 22 | #:use-module ((guix utils) |
| 23 | ;; Rename the 'location' binding to allow proper syntax | ||
| 24 | ;; matching when setting the 'location' field of a package. | ||
| 25 | #:renamer (lambda (name) | ||
| 26 | (cond ((eq? name 'location) 'make-location) | ||
| 27 | (else name)))) | ||
| 23 | #:use-module (guix hash) | 28 | #:use-module (guix hash) |
| 24 | #:use-module (guix derivations) | 29 | #:use-module (guix derivations) |
| 25 | #:use-module (guix packages) | 30 | #:use-module (guix packages) |
| @@ -34,6 +39,7 @@ | |||
| 34 | #:use-module (srfi srfi-34) | 39 | #:use-module (srfi srfi-34) |
| 35 | #:use-module (srfi srfi-64) | 40 | #:use-module (srfi srfi-64) |
| 36 | #:use-module (rnrs io ports) | 41 | #:use-module (rnrs io ports) |
| 42 | #:use-module (ice-9 regex) | ||
| 37 | #:use-module (ice-9 match)) | 43 | #:use-module (ice-9 match)) |
| 38 | 44 | ||
| 39 | ;; Test the high-level packaging layer. | 45 | ;; Test the high-level packaging layer. |
| @@ -52,6 +58,21 @@ | |||
| 52 | (home-page #f) (license #f) | 58 | (home-page #f) (license #f) |
| 53 | extra-fields ...)) | 59 | extra-fields ...)) |
| 54 | 60 | ||
| 61 | (test-assert "printer with location" | ||
| 62 | (string-match "^#<package foo-0 foo.scm:42 [[:xdigit:]]+>$" | ||
| 63 | (with-output-to-string | ||
| 64 | (lambda () | ||
| 65 | (write | ||
| 66 | (dummy-package "foo" | ||
| 67 | (location (make-location "foo.scm" 42 7)))))))) | ||
| 68 | |||
| 69 | (test-assert "printer without location" | ||
| 70 | (string-match "^#<package foo-0 [[:xdigit:]]+>$" | ||
| 71 | (with-output-to-string | ||
| 72 | (lambda () | ||
| 73 | (write | ||
| 74 | (dummy-package "foo" (location #f))))))) | ||
| 75 | |||
| 55 | (test-assert "package-field-location" | 76 | (test-assert "package-field-location" |
| 56 | (let () | 77 | (let () |
| 57 | (define (goto port line column) | 78 | (define (goto port line column) |
