diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-07-17 15:40:06 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-07-17 15:40:06 +0200 |
| commit | 2cf0ea0dbbd5a43a62dadb81948ee29898585dd7 (patch) | |
| tree | 742b2ea6f4f270f93dd1f0b2acda4ba14a5f806d | |
| parent | 8aaaae38a37f806a62284c6bce116586d8b66b87 (diff) | |
| download | guix-2cf0ea0dbbd5a43a62dadb81948ee29898585dd7.tar.gz | |
gexp: Gracefully handle printing of gexps with spliced references.
* guix/gexp.scm (write-gexp): Wrap 'write' call in
'false-if-exception'.
* tests/gexp.scm ("printer", "printer vs. ungexp-splicing"): New tests.
| -rw-r--r-- | guix/gexp.scm | 7 | ||||
| -rw-r--r-- | tests/gexp.scm | 18 |
2 files changed, 24 insertions, 1 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 260118affa..c9f6cbe99a 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -60,7 +60,12 @@ (define (write-gexp gexp port) "Write GEXP on PORT." (display "#<gexp " port) - (write (apply (gexp-proc gexp) (gexp-references gexp)) port) + + ;; Try to write the underlying sexp. Now, this trick doesn't work when + ;; doing things like (ungexp-splicing (gexp ())) because GEXP's procedure + ;; tries to use 'append' on that, which fails with wrong-type-arg. + (false-if-exception + (write (apply (gexp-proc gexp) (gexp-references gexp)) port)) (format port " ~a>" (number->string (object-address gexp) 16))) diff --git a/tests/gexp.scm b/tests/gexp.scm index b0ff1019e6..6d4885e44e 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -29,6 +29,7 @@ #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (ice-9 popen)) ;; Test the (guix gexp) module. @@ -247,6 +248,23 @@ (return (and (zero? (close-pipe pipe)) (= (expt n 2) (string->number str))))))) +(test-assert "printer" + (string-match "^#<gexp \\(string-append .*#<package coreutils.*\ + \"/bin/uname\"\\) [[:xdigit:]]+>$" + (with-output-to-string + (lambda () + (write + (gexp (string-append (ungexp coreutils) + "/bin/uname"))))))) + +(test-assert "printer vs. ungexp-splicing" + (string-match "^#<gexp .* [[:xdigit:]]+>$" + (with-output-to-string + (lambda () + ;; #~(begin #$@#~()) + (write + (gexp (begin (ungexp-splicing (gexp ()))))))))) + (test-equal "sugar" '(gexp (foo (ungexp bar) (ungexp baz "out") (ungexp (chbouib 42)) |