From 2e1bafb03438757c7cc34c16230b00623507ff84 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 8 Oct 2014 23:06:19 +0200
Subject: [PATCH] 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.
---
guix/packages.scm | 9 ++++++---
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 @@ (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)))))
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 @@
(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)
--
GitLab