me/guix
Archived
1
0
Fork 0
Code Activity

gexp: Gracefully handle printing of gexps with spliced references.

Browse source 
* guix/gexp.scm (write-gexp): Wrap 'write' call in
  'false-if-exception'.
* tests/gexp.scm ("printer", "printer vs. ungexp-splicing"): New tests.
This commit is contained in:
Ludovic Courtès 2014-07-17 15:40:06 +02:00
parent 8aaaae38a3
commit 2cf0ea0dbb
2 changed files with 24 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
guix/gexp.scm
View file

@ -60,7 +60,12 @@
(define (write-gexp gexp port) (define (write-gexp gexp port)
"Write GEXP on PORT." "Write GEXP on PORT."
(display "#<gexp " 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>" (format port " ~a>"
(number->string (object-address gexp) 16))) (number->string (object-address gexp) 16)))

18
tests/gexp.scm
View file

@ -29,6 +29,7 @@
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 popen)) #:use-module (ice-9 popen))
;; Test the (guix gexp) module. ;; Test the (guix gexp) module.
@ -247,6 +248,23 @@
(return (and (zero? (close-pipe pipe)) (return (and (zero? (close-pipe pipe))
(= (expt n 2) (string->number str))))))) (= (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" (test-equal "sugar"
'(gexp (foo (ungexp bar) (ungexp baz "out") '(gexp (foo (ungexp bar) (ungexp baz "out")
(ungexp (chbouib 42)) (ungexp (chbouib 42))