diff --git a/collects/tests/eli-tester.ss b/collects/tests/eli-tester.ss
index dbe674f929..3e78d9627b 100644
--- a/collects/tests/eli-tester.ss
+++ b/collects/tests/eli-tester.ss
@@ -28,7 +28,28 @@
     [x (format "INTERNAL ERROR, unexpected value: ~s" x)]))
 
 (define test-context    (make-parameter #f))
-(define failure-message (make-parameter #f))
+(define failure-format 
+  (make-parameter
+   (lambda (prefix qe fmt . args)
+     (define prefix-str 
+       (apply string-append 
+              (add-between (reverse (list* "" prefix))
+                           " > ")))
+     (define str 
+       (regexp-replace #rx"\n"
+                       (apply format fmt args)
+                       "\n  "))
+     (format "~atest failure in ~e\n  ~a"
+             prefix-str qe str))))
+
+(define (make-failure-message msg)
+  (define str
+    (regexp-replace #rx"\n" msg "\n  "))
+  (define real-msg
+    (format "test failure\n  ~a" str))
+  (lambda (prefix qe fmt . args)
+    real-msg))
+(define failure-prefix-mark (gensym 'failure-prefix))
 
 (define-syntax (test-thunk stx)
   (define (blame e fmt . args)
@@ -41,13 +62,10 @@
                        [(syntax-position e) => (lambda (p) (format "#~a" p))]
                        [else "?"])))))
     (with-syntax ([e e] [fmt fmt] [(arg ...) args] [loc loc])
-      #'(let* ([msg (failure-message)]
-               [str (regexp-replace #rx"\n"
-                                    (if msg (msg) (format fmt arg ...))
-                                    "\n  ")])
-          (if msg
-            (error 'loc "test failure\n  ~a" str)
-            (error 'loc "test failure in ~e\n  ~a" 'e str)))))
+      #'(let* ([form (failure-format)]
+               [prefix
+                (continuation-mark-set->list (current-continuation-marks) failure-prefix-mark)])
+          (error 'loc (form prefix 'e fmt arg ...)))))
   (define (t1 x)
     #`(let ([x (safe #,x)])
         (unless (and (eq? 'values (car x)) (= 2 (length x)) (cadr x))
@@ -55,7 +73,7 @@
                    #'(show x)))))
   (define (t2 x y [eval2? #t])
     #`(let* ([x (safe #,x)]                   [xtag (car x)]
-             [y #,(if eval2? #`(safe #,y) y)] [ytag (car y)])
+                                              [y #,(if eval2? #`(safe #,y) y)] [ytag (car y)])
         (cond
           [(eq? ytag 'values)
            (unless (equal? x y)
@@ -93,19 +111,26 @@
                         (let ([e (syntax-e x)])
                           (if (or (memq e '(do => <= =error> <error=))
                                   (keyword? e))
-                            e x)))
+                              e x)))
                       (cdr (syntax->list stx)))]
              [r '()])
     (let ([t (let tloop ([xs xs])
                (match xs
+                 [(list* #:failure-prefix msg r)
+                  (let ([r (tloop r)])
+                    (if (pair? r)
+                        (cons
+                         #`(with-continuation-mark failure-prefix-mark #,msg #,(car r))
+                         (cdr r))
+                        r))]
                  [(list* #:failure-message msg r)
                   (let ([r (tloop r)])
                     (if (pair? r)
-                      (cons
-                       #`(parameterize ([failure-message (lambda () #,msg)])
-                           #,(car r))
-                       (cdr r))
-                      r))]
+                        (cons
+                         #`(parameterize ([failure-format (make-failure-message #,msg)])
+                             #,(car r))
+                         (cdr r))
+                        r))]
                  [(list* 'do x r) ; to avoid counting non-test exprs as tests
                   (cons (tb x) r)]
                  [(list* x '=> y r)      (cons (try t2 x y) r)]
@@ -120,26 +145,26 @@
                     [_ (cons (try t1 x) r)])]
                  [(list) '()]))])
       (if (pair? t)
-        (loop (cdr t) (cons (car t) r))
-        #`(lambda () #,@(reverse r))))))
+          (loop (cdr t) (cons (car t) r))
+          #`(lambda () #,@(reverse r))))))
 
 (define (run-tests thunk force-new-context?)
   (if (and (test-context) (not force-new-context?))
-    (thunk)
-    (let ([c (mcons 0 '())])
-      (parameterize ([test-context c])
-        (dynamic-wind
-          void
-          thunk
-          (lambda ()
-            (test-context #f)
-            (let ([num (mcar c)] [exns (mcdr c)])
-              (if (null? exns)
-                (printf "~a test~a passed\n" num (if (= num 1) "" "s"))
-                (error 'test "~a/~a test failures:~a" (length exns) num
-                       (string-append*
-                        (append-map (lambda (e) (list "\n" (exn-message e)))
-                                    (reverse exns))))))))))))
+      (thunk)
+      (let ([c (mcons 0 '())])
+        (parameterize ([test-context c])
+          (dynamic-wind
+           void
+           thunk
+           (lambda ()
+             (test-context #f)
+             (let ([num (mcar c)] [exns (mcdr c)])
+               (if (null? exns)
+                   (printf "~a test~a passed\n" num (if (= num 1) "" "s"))
+                   (error 'test "~a/~a test failures:~a" (length exns) num
+                          (string-append*
+                           (append-map (lambda (e) (list "\n" (exn-message e)))
+                                       (reverse exns))))))))))))
 
 (provide test test*)
 (define-syntax-rule (test  x0 x ...) (run-tests (test-thunk x0 x ...) #f))
@@ -163,7 +188,7 @@
  (car '()) => (error "expects argument of type")
  ;; syntax errors
  (if 1) =error> "if: bad syntax"
-
+ 
  ;; error (and non-exception raises) predicates
  (+ 1 "2")   =error> exn:fail:contract?
  (+ 1 "2")   =error> (lambda (x) (not (exn:fail:filesystem? x)))
@@ -171,7 +196,7 @@
  (error "1") =error> exn?
  (raise 1)   =error> number?
  (raise "1") =error> string?
-
+ 
  ;; test `test' errors
  (test* (/ 0)) =error> "expected: non-#f single value"
  (test* 1 => 2) =error> "expected: 2"
@@ -180,7 +205,8 @@
  (test* (raise 1) =error> "foo") =error> "raised non-exception"
  (test* #:failure-message "FOO" (/ 0) => 1) =error> "FOO"
  (test* #:failure-message "FOO" (/ 0)) =error> "FOO"
-
+ (test* #:failure-prefix "FOO" (/ 0)) =error> "FOO"
+ 
  ;; test possitive message
  (let ([o (open-output-bytes)])
    (list (begin (parameterize ([current-output-port o]) (test* 1 => 1))