From 19dfed1da95bcbee69b66187f95a495efa899e62 Mon Sep 17 00:00:00 2001
From: Joe Thornber <ejt@redhat.com>
Date: Fri, 15 Dec 2017 10:21:59 +0000
Subject: [PATCH] [functional-tests] Log exceptions properly

---
 functional-tests/functional-tests.scm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/functional-tests/functional-tests.scm b/functional-tests/functional-tests.scm
index 78053e4..b1c6c64 100644
--- a/functional-tests/functional-tests.scm
+++ b/functional-tests/functional-tests.scm
@@ -111,6 +111,15 @@
     (apply string-append cwd "/"
            (intersperse "/" (map symbol->string keys))))
 
+  (define (log-exceptions thunk)
+    (with-exception-handler
+      (lambda (x)
+        (let-values (((txt-port get) (open-string-output-port)))
+          (display-condition x txt-port)
+          (log-error (get)))
+        (raise x))
+      thunk))
+
   (define-syntax define-scenario
     (lambda (x)
       (syntax-case x ()
@@ -124,7 +133,7 @@
                                        (file-options no-fail)
                                        (buffer-mode line)
                                        (native-transcoder))
-                        b1 b2 ...)))))))))
+                        (log-exceptions (lambda () b1 b2 ...)))))))))))
 
   (define (fail msg)
     (raise (condition
@@ -149,9 +158,9 @@
             (if (error? x)
                 (k #f)
                 (raise x)))
-            (lambda ()
-              (thunk)
-              #t)))))
+          (lambda ()
+            (thunk)
+            #t)))))
 
   ;; Returns #t if all tests pass.
   (define (run-scenarios ss)