...

original commit: 1e976458c1b48e35f7d3c9be99b427a16855c921

collects/tests/framework/canvas.ss

@@ -0,0 +1,10 @@
+(define (test-creation class name)
+  (test
+   name
+   (lambda (x) #t)
+   `(let ([f (make-object frame:basic%)]
+	  [c (make-object ,class f)])
+      (send f show #t))))
+
+(test-creation 'canvas:wide-snip-mixin-creation '(canvas:wide-snip-mixin editor-canvas%))
+(test-creation 'canvas:wide-snip%-creation 'canvas:wide-snip%)

collects/tests/framework/main.ss

@@ -158,7 +158,7 @@
 	(fluid-let ([test-name in-test-name])
 	  (when (or (not only-these-tests)
 		    (memq test-name only-these-tests))
-	    (let ([passed
+	    (let ([failed
 		   (with-handlers ([(lambda (x) #t)
 				    (lambda (x)
 				      (if (exn? x)
@@ -170,9 +170,9 @@
 				(begin0 (send-sexp-to-mred sexp/proc)
 					(send-sexp-to-mred ''check-for-errors)))])
 
-		       (passed? result)))])
-	      (unless passed
-		(printf "FAILED ~a~n" test-name)
+		       (not (passed? result))))])
+	      (when failed
+		(printf "FAILED ~a: ~a~n" failed test-name)
 		(case jump
 		  [(section) (section-jump)]
 		  [(continue) (void)]