2 files changed, 24 insertions(+), 1 deletions(-)

M guix/gexp.scm
M tests/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)))
 

@@ 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))