From e10677ed464319816d36f1d545c3111f227b7eab Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Sun, 13 May 2012 23:11:26 +0200
Subject: SRFI-64: Write log files as UTF-8; display a backtrace upon error.

Changed copied from libchop v0.5.2-25-g657b029.

* src/guile/srfi/srfi-64.upstream.scm (test-on-group-begin-simple)[guile-2]:
  Set %default-port-encoding to "UTF-8".
  (%test-evaluate-with-catch): Call `display-backtrace' upon error.
---
 src/guile/srfi/srfi-64.upstream.scm | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/guile/srfi/srfi-64.upstream.scm b/src/guile/srfi/srfi-64.upstream.scm
index 15de1f1..037ba02 100644
--- a/src/guile/srfi/srfi-64.upstream.scm
+++ b/src/guile/srfi/srfi-64.upstream.scm
@@ -314,6 +314,10 @@
 		   (log-file
 		    (cond-expand (mzscheme
 				  (open-output-file log-file-name 'truncate/replace))
+                                 (guile-2
+                                  (with-fluids ((%default-port-encoding
+                                                 "UTF-8"))
+                                    (open-output-file log-file-name)))
 				 (else (open-output-file log-file-name)))))
 	      (display "%%%% Starting test " log-file)
 	      (display suite-name log-file)
@@ -565,7 +569,11 @@
   (define-syntax %test-evaluate-with-catch
     (syntax-rules ()
       ((%test-evaluate-with-catch test-expression)
-       (catch #t (lambda () test-expression) (lambda (key . args) #f))))))
+       (catch #t
+         (lambda () test-expression)
+         (lambda (key . args) #f)
+         (lambda (key . args)
+           (display-backtrace (make-stack #t) (current-error-port))))))))
  (kawa
   (define-syntax %test-evaluate-with-catch
     (syntax-rules ()
-- 
cgit v1.2.3