diff options
| -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)) |