...

original commit: 8c129225c43f52024c2f4b82fdb192bdf8b9f31a

collects/tests/framework/framework-test-engine.ss

@@ -1,3 +1,5 @@
+(require-library "errortrace.ss" "errortrace")
+
 (let* ([errs null]
        [sema (make-semaphore 1)]
        [protect
@@ -6,10 +8,19 @@
 	  (begin0 (f)
 		  (semaphore-post sema)))])
   (thread
-   (let ([print-convert
-	  (parameterize ([current-namespace (make-namespace)])
-	    (require-library "pconvert.ss")
-	    (global-defined-value 'print-convert))])
+   (let* ([print-convert
+	   (parameterize ([current-namespace (make-namespace)])
+	     (require-library "pconvert.ss")
+	     (global-defined-value 'print-convert))]
+	  [exception->string
+	   (lambda (x)
+	     (if (exn? x)
+		 (if (defined? 'errortrace-print-trace)
+		     (let ([p (open-output-string)])
+		       (errortrace-print-trace p x)
+		       (string-append (exn-message x) (string #\newline) (get-output-string p)))
+		     (exn-message x))
+		 (format "~s" x)))])
      (lambda ()
        (let*-values ([(in out) (tcp-connect "localhost" (load-relative "receive-sexps-port.ss"))]
 		     [(continue) (make-semaphore 0)])
@@ -24,23 +35,16 @@
 		   (write
 		    (let ([these-errs (protect (lambda () (begin0 errs (set! errs null))))])
 		      (if (null? these-errs)
-			  (with-handlers ([(lambda (x) #t)
-					   (lambda (exn)
-					     (list 'error (if (exn? exn)
-							      (exn-message exn)
-							      (format "~s" exn))))])
+			  (with-handlers ([(lambda (x) #t) 
+					   (lambda (x) (list 'error (exception->string x)))])
 			    (list 'normal (print-convert (eval sexp))))
 			  (list 'error
 				(apply string-append
-				       (map (lambda (x)
-					      (string-append
-					       (if (exn? x) (exn-message x) (format "~s" x))
-					       (string #\newline)))
+				       (map (lambda (x) (string-append (exception->string x) (string #\newline)))
 					    these-errs)))))
-		    
 		    out)
 		   (loop)))))))))
-
+  
   (let ([od (event-dispatch-handler)]
 	[port (current-output-port)])
     (event-dispatch-handler

collects/tests/framework/panel.ss

@@ -0,0 +1,4 @@
+(test 
+ 'single-panel
+ (lambda (x) (eq? x 'passed))
+ `passed)

collects/tests/framework/prefs.ss

@@ -41,7 +41,7 @@
 		(preferences:get ',pref-sym))))
 
 
-(test 'preference-dialog-appears
+(test 'dialog-appears
       (lambda (x) (eq? 'passed x))
       (lambda ()
 	(send-sexp-to-mred '(preferences:show-dialog))