* lisp/emacs-lisp/cl.el (flet): Mark obsolete.

* lisp/emacs-lisp/cl-macs.el (cl-flet*): New macro.
* lisp/vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse):
* lisp/progmodes/js.el (js-c-fill-paragraph):
* lisp/progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class)
(ebrowse-switch-member-buffer-to-derived-class):
* test/automated/ert-x-tests.el (ert-test-run-tests-interactively-2):
* lisp/play/5x5.el (5x5-solver): Use cl-flet.

Fixes: debbugs:11780

11 files changed, 231 insertions, 191 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 180f87e46b0..cb70d88b849 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,13 @@
 2012-06-27  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/cl.el (flet): Mark obsolete.
+	* emacs-lisp/cl-macs.el (cl-flet*): New macro.
+	* vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse):
+	* progmodes/js.el (js-c-fill-paragraph):
+	* progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class)
+	(ebrowse-switch-member-buffer-to-derived-class):
+	* play/5x5.el (5x5-solver): Use cl-flet.
+
 	* emacs-lisp/cl.el: Use lexical-binding.  Fix flet (bug#11780).
 	(cl--symbol-function): New macro.
 	(cl--letf, cl--letf*): Use it.
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index f7eaa3b9f9c..4d7e1ecc8b0 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -260,12 +260,12 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
 ;;;;;;  cl-deftype cl-defstruct cl-callf2 cl-callf cl-rotatef cl-shiftf
 ;;;;;;  cl-remf cl-psetf cl-declare cl-the cl-locally cl-multiple-value-setq
 ;;;;;;  cl-multiple-value-bind cl-symbol-macrolet cl-macrolet cl-labels
-;;;;;;  cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
+;;;;;;  cl-flet* cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
 ;;;;;;  cl-dotimes cl-dolist cl-do* cl-do cl-loop cl-return-from
 ;;;;;;  cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
 ;;;;;;  cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
 ;;;;;;  cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
-;;;;;;  "41a15289eda7e6ae03ac9edd86bbb1a6")
+;;;;;;  "e7bb76130254614df1603a1c1e89cb49")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'cl-gensym "cl-macs" "\
@@ -492,6 +492,14 @@ Like `cl-labels' but the definitions are not recursive.
 
 (put 'cl-flet 'lisp-indent-function '1)
 
+(autoload 'cl-flet* "cl-macs" "\
+Make temporary function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
+
+(put 'cl-flet* 'lisp-indent-function '1)
+
 (autoload 'cl-labels "cl-macs" "\
 Make temporary function bindings.
 The bindings can be recursive.  Assumes the use of `lexical-binding'.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index eaa988bfb58..39e230cb32c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1570,7 +1570,6 @@ a `let' form, except that the list of symbols can be computed at run-time."
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
-;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make temporary function definitions.
@@ -1596,6 +1595,18 @@ Like `cl-labels' but the definitions are not recursive.
              (cons (cons 'function #'cl--labels-convert) newenv)))))))
 
 ;;;###autoload
+(defmacro cl-flet* (bindings &rest body)
+  "Make temporary function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
+  (cond
+   ((null bindings) (macroexp-progn body))
+   ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+   (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
+
+;;;###autoload
 (defmacro cl-labels (bindings &rest body)
   "Make temporary function bindings.
 The bindings can be recursive.  Assumes the use of `lexical-binding'.
@@ -2257,6 +2268,7 @@ STRING is an optional description of the desired type."
 
 ;;;###autoload
 (defmacro cl-assert (form &optional show-args string &rest args)
+  ;; FIXME: This is actually not compatible with Common-Lisp's `assert'.
   "Verify that FORM returns non-nil; signal an error if not.
 Second arg SHOW-ARGS means to include arguments of FORM in message.
 Other args STRING and ARGS... are arguments to be passed to `error'.
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 7996af4e02d..0b6d9cd2223 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -461,11 +461,13 @@ Common Lisp.
 
 ;; This should really have some way to shadow 'byte-compile properties, etc.
 (defmacro flet (bindings &rest body)
-  "Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+  "Make temporary overriding function definitions.
+This is an analogue of a dynamically scoped `let' that operates on the function
+cell of FUNCs rather than their value cell.
+If you want the Common-Lisp style of `flet', you should use `cl-flet'.
+The FORMs are evaluated with the specified function definitions in place,
+then the definitions are undone (the FUNCs go back to their previous
+definitions, or lack thereof).
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1) (debug cl-flet))
@@ -491,6 +493,7 @@ will not work - use `labels' instead" (symbol-name (car x))))
                 (list `(symbol-function ',(car x)) func)))
             bindings)
      ,@body))
+(make-obsolete 'flet "Use either `cl-flet' or `letf'."  "24.2")
 
 (defmacro labels (bindings &rest body)
   "Make temporary function bindings.
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index b2fffb49840..c0a642941f4 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -568,14 +568,14 @@ to complete the 5x5.
 
 Solutions are sorted from least to greatest Hamming weight."
   (require 'calc-ext)
-  (flet ((5x5-mat-mode-2
-	  (a)
-	  (math-map-vec
-	   (lambda (y)
-	     (math-map-vec
-	      (lambda (x) `(mod ,x 2))
-	      y))
-	   a)))
+  (cl-flet ((5x5-mat-mode-2
+             (a)
+             (math-map-vec
+              (lambda (y)
+                (math-map-vec
+                 (lambda (x) `(mod ,x 2))
+                 y))
+              a)))
     (let* (calc-command-flags
 	   (grid-size-squared (* 5x5-grid-size 5x5-grid-size))
 
@@ -658,8 +658,8 @@ Solutions are sorted from least to greatest Hamming weight."
 		       (cdr (5x5-mat-mode-2
 			     '(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1
 					1 1 0 1 0 1 0 1 1 1 0)
-				   (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
-					1 0 0 0 0 0 1 1 0 1 1)))))
+                               (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
+                                    1 0 0 0 0 0 1 1 0 1 1)))))
 	       (calcFunc-trn id))))
 
 	   (inv-base-change
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 5c2ba080d31..ce190d25157 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -2957,10 +2957,10 @@ Prefix arg INC specifies which one."
   (let ((containing-list ebrowse--tree)
 	index cls
 	(supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
-    (flet ((trees-alist (trees)
-			(loop for tr in trees
-			      collect (cons (ebrowse-cs-name
-					     (ebrowse-ts-class tr)) tr))))
+    (cl-flet ((trees-alist (trees)
+                           (loop for tr in trees
+                                 collect (cons (ebrowse-cs-name
+                                                (ebrowse-ts-class tr)) tr))))
       (when supers
 	(let ((tree (if (second supers)
 			(ebrowse-completing-read-value
@@ -2985,11 +2985,11 @@ Prefix arg INC specifies which one."
 Prefix arg ARG says which class should be displayed.  Default is
 the first derived class."
   (interactive "P")
-  (flet ((ebrowse-tree-obarray-as-alist ()
-					(loop for s in (ebrowse-ts-subclasses
-							ebrowse--displayed-class)
-					      collect (cons (ebrowse-cs-name
-							     (ebrowse-ts-class s)) s))))
+  (cl-flet ((ebrowse-tree-obarray-as-alist ()
+               (loop for s in (ebrowse-ts-subclasses
+                               ebrowse--displayed-class)
+                     collect (cons (ebrowse-cs-name
+                                    (ebrowse-ts-class s)) s))))
     (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
 		    (error "No derived classes"))))
       (if (and arg (second subs))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index cdc3ef1c2e0..2e943be412b 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1821,15 +1821,15 @@ nil."
 (defun js-c-fill-paragraph (&optional justify)
   "Fill the paragraph with `c-fill-paragraph'."
   (interactive "*P")
-  (flet ((c-forward-sws
-          (&optional limit)
-          (js--forward-syntactic-ws limit))
-         (c-backward-sws
-          (&optional limit)
-          (js--backward-syntactic-ws limit))
-         (c-beginning-of-macro
-          (&optional limit)
-          (js--beginning-of-macro limit)))
+  (letf (((symbol-function 'c-forward-sws)
+          (lambda (&optional limit)
+            (js--forward-syntactic-ws limit)))
+         ((symbol-function 'c-backward-sws)
+          (lambda (&optional limit)
+            (js--backward-syntactic-ws limit)))
+         ((symbol-function 'c-beginning-of-macro)
+          (lambda (&optional limit)
+            (js--beginning-of-macro limit))))
     (let ((fill-paragraph-function 'c-fill-paragraph))
       (c-fill-paragraph justify))))
 
diff --git a/lisp/ses.el b/lisp/ses.el
index a6a6aa91b5c..7429653c7de 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -3380,21 +3380,23 @@ Use `math-format-value' as a printer for Calc objects."
 	    (setq iter (cdr iter))))
 	(setq result ret)))
 
-    (flet ((vectorize-*1
-	    (clean result)
-	    (cons clean (cons (quote 'vec) (apply 'append result))))
-	   (vectorize-*2
-	    (clean result)
-	    (cons clean (cons (quote 'vec) (mapcar (lambda (x)
-						     (cons  clean (cons (quote 'vec) x)))
-						   result)))))
+    (cl-flet ((vectorize-*1
+               (clean result)
+               (cons clean (cons (quote 'vec) (apply 'append result))))
+              (vectorize-*2
+               (clean result)
+               (cons clean (cons (quote 'vec)
+                                 (mapcar (lambda (x)
+                                           (cons  clean (cons (quote 'vec) x)))
+                                         result)))))
       (case vectorize
 	((nil) (cons clean (apply 'append result)))
 	((*1) (vectorize-*1 clean result))
 	((*2) (vectorize-*2 clean result))
-	((*) (if (cdr result)
-	       (vectorize-*2 clean result)
-	     (vectorize-*1 clean result)))))))
+	((*) (funcall (if (cdr result)
+                          #'vectorize-*2
+                        #'vectorize-*1)
+                      clean result))))))
 
 (defun ses-delete-blanks (&rest args)
   "Return ARGS reversed, with the blank elements (nil and *skip*) removed."
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 104e6fd59e3..4f50e1c8690 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -679,9 +679,9 @@ Optional arg REVISION is a revision to annotate from."
     ;; Apply reverse-chronological edits on the trunk, computing and
     ;; accumulating forward-chronological edits after some point, for
     ;; later.
-    (flet ((r/d/a () (vector pre
-                             (cdr (assq 'date meta))
-                             (cdr (assq 'author meta)))))
+    (cl-flet ((r/d/a () (vector pre
+                                (cdr (assq 'date meta))
+                                (cdr (assq 'author meta)))))
       (while (when (setq pre cur cur (cdr (assq 'next meta)))
                (not (string= "" cur)))
         (setq
@@ -769,16 +769,16 @@ Optional arg REVISION is a revision to annotate from."
                  ht)
         (setq maxw (max w maxw))))
     (let ((padding (make-string maxw 32)))
-      (flet ((pad (w) (substring-no-properties padding w))
-             (render (rda &rest ls)
-                     (propertize
-                      (apply 'concat
-                             (format-time-string "%Y-%m-%d" (aref rda 1))
-                             "  "
-                             (aref rda 0)
-                             ls)
-                      :vc-annotate-prefix t
-                      :vc-rcs-r/d/a rda)))
+      (cl-flet ((pad (w) (substring-no-properties padding w))
+                (render (rda &rest ls)
+                        (propertize
+                         (apply 'concat
+                                (format-time-string "%Y-%m-%d" (aref rda 1))
+                                "  "
+                                (aref rda 0)
+                                ls)
+                         :vc-annotate-prefix t
+                         :vc-rcs-r/d/a rda)))
         (maphash
          (if all-me
              (lambda (rda w)
@@ -1306,50 +1306,51 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
         ;; to "de-@@-format" the printed representation as the first step
         ;; to translating it into some value.  See internal func `gather'.
         @-holes)
-    (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
-           (at (tag) (save-excursion (eq tag (read buffer))))
-           (to-eol () (buffer-substring-no-properties
-                       (point) (progn (forward-line 1)
-                                      (1- (point)))))
-           (to-semi () (setq b (point)
-                             e (progn (search-forward ";")
-                                      (1- (point)))))
-           (to-one@ () (setq @-holes nil
-                             b (progn (search-forward "@") (point))
-                             e (progn (while (and (search-forward "@")
-                                                  (= ?@ (char-after))
-                                                  (progn
-                                                    (push (point) @-holes)
-                                                    (forward-char 1)
-                                                    (push (point) @-holes))))
-                                      (1- (point)))))
-           (tok+val (set-b+e name &optional proc)
-                    (unless (eq name (setq tok (read buffer)))
-                      (error "Missing `%s' while parsing %s" name context))
-                    (sw)
-                    (funcall set-b+e)
-                    (cons tok (if proc
-                                  (funcall proc)
-                                (buffer-substring-no-properties b e))))
-           (k-semi (name &optional proc) (tok+val 'to-semi name proc))
-           (gather () (let ((pairs `(,e ,@@-holes ,b))
-                            acc)
-                        (while pairs
-                          (push (buffer-substring-no-properties
-                                 (cadr pairs) (car pairs))
-                                acc)
-                          (setq pairs (cddr pairs)))
-                        (apply 'concat acc)))
-           (k-one@ (name &optional later) (tok+val 'to-one@ name
-                                                   (if later
-                                                       (lambda () t)
-                                                     'gather))))
+    (cl-flet*
+        ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
+         (at (tag) (save-excursion (eq tag (read buffer))))
+         (to-eol () (buffer-substring-no-properties
+                     (point) (progn (forward-line 1)
+                                    (1- (point)))))
+         (to-semi () (setq b (point)
+                           e (progn (search-forward ";")
+                                    (1- (point)))))
+         (to-one@ () (setq @-holes nil
+                           b (progn (search-forward "@") (point))
+                           e (progn (while (and (search-forward "@")
+                                                (= ?@ (char-after))
+                                                (progn
+                                                  (push (point) @-holes)
+                                                  (forward-char 1)
+                                                  (push (point) @-holes))))
+                                    (1- (point)))))
+         (tok+val (set-b+e name &optional proc)
+                  (unless (eq name (setq tok (read buffer)))
+                    (error "Missing `%s' while parsing %s" name context))
+                  (sw)
+                  (funcall set-b+e)
+                  (cons tok (if proc
+                                (funcall proc)
+                              (buffer-substring-no-properties b e))))
+         (k-semi (name &optional proc) (tok+val #'to-semi name proc))
+         (gather () (let ((pairs `(,e ,@@-holes ,b))
+                          acc)
+                      (while pairs
+                        (push (buffer-substring-no-properties
+                               (cadr pairs) (car pairs))
+                              acc)
+                        (setq pairs (cddr pairs)))
+                      (apply 'concat acc)))
+         (k-one@ (name &optional later) (tok+val #'to-one@ name
+                                                 (if later
+                                                     (lambda () t)
+                                                   #'gather))))
       (save-excursion
         (goto-char (point-min))
         ;; headers
         (setq context 'headers)
-        (flet ((hpush (name &optional proc)
-                      (push (k-semi name proc) headers)))
+        (cl-flet ((hpush (name &optional proc)
+                         (push (k-semi name proc) headers)))
           (hpush 'head)
           (when (at 'branch)
             (hpush 'branch))
@@ -1391,7 +1392,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                                (when (< (car ls) 100)
                                  (setcar ls (+ 1900 (car ls))))
                                (apply 'encode-time (nreverse ls)))))
-                  ,@(mapcar 'k-semi '(author state))
+                  ,@(mapcar #'k-semi '(author state))
                   ,(k-semi 'branches
                            (lambda ()
                              (split-string
@@ -1421,16 +1422,17 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
               ;; only the former since it behaves identically to the
               ;; latter in the absence of "@@".)
               sub)
-          (flet ((incg (beg end) (let ((b beg) (e end) @-holes)
-                                   (while (and asc (< (car asc) e))
-                                     (push (pop asc) @-holes))
-                                   ;; Self-deprecate when work is done.
-                                   ;; Folding many dimensions into one.
-                                   ;; Thanks B.Mandelbrot, for complex sum.
-                                   ;; O beauteous math! --the Unvexed Bum
-                                   (unless asc
-                                     (setq sub 'buffer-substring-no-properties))
-                                   (gather))))
+          (cl-flet ((incg (beg end)
+                          (let ((b beg) (e end) @-holes)
+                            (while (and asc (< (car asc) e))
+                              (push (pop asc) @-holes))
+                            ;; Self-deprecate when work is done.
+                            ;; Folding many dimensions into one.
+                            ;; Thanks B.Mandelbrot, for complex sum.
+                            ;; O beauteous math! --the Unvexed Bum
+                            (unless asc
+                              (setq sub #'buffer-substring-no-properties))
+                            (gather))))
             (while (and (sw)
                         (not (eobp))
                         (setq context (to-eol)
@@ -1449,8 +1451,8 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                   (setcdr (cadr rev) (gather))
                 (if @-holes
                     (setq asc (nreverse @-holes)
-                          sub 'incg)
-                  (setq sub 'buffer-substring-no-properties))
+                          sub #'incg)
+                  (setq sub #'buffer-substring-no-properties))
                 (goto-char b)
                 (setq acc nil)
                 (while (< (point) e)
diff --git a/test/ChangeLog b/test/ChangeLog
index ddd26bf492a..45fc70e0440 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,7 +1,12 @@
+2012-06-27  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* automated/ert-x-tests.el (ert-test-run-tests-interactively-2):
+	Use cl-flet.
+
 2012-06-08  Ulf Jasper  <ulf.jasper@web.de>
 
-	* automated/icalendar-tests.el (icalendar--parse-vtimezone): Test
-	escaped commas in TZID (Bug#11473).
+	* automated/icalendar-tests.el (icalendar--parse-vtimezone):
+	Test escaped commas in TZID (Bug#11473).
 	(icalendar-import-with-timezone): New.
 	(icalendar-real-world): Add new testcase as given in the bugreport
 	of Bug#11473.
@@ -332,8 +337,8 @@
 2009-12-18  Ulf Jasper  <ulf.jasper@web.de>
 
 	* icalendar-testsuite.el
-	(icalendar-testsuite--run-function-tests): Add
-	icalendar-testsuite--test-parse-vtimezone.
+	(icalendar-testsuite--run-function-tests):
+	Add icalendar-testsuite--test-parse-vtimezone.
 	(icalendar-testsuite--test-parse-vtimezone): New.
 	(icalendar-testsuite--do-test-cycle): Doc changes.
 	(icalendar-testsuite--run-real-world-tests): Remove trailing
@@ -375,7 +380,7 @@
 2008-10-31  Ulf Jasper  <ulf.jasper@web.de>
 
 	* icalendar-testsuite.el (icalendar-testsuite--run-function-tests):
-	Added `icalendar-testsuite--test-create-uid'.
+	Add `icalendar-testsuite--test-create-uid'.
 	(icalendar-testsuite--test-create-uid): New.
 
 2008-06-14  Ulf Jasper  <ulf.jasper@web.de>
diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el
index bb05608e418..520502bb307 100644
--- a/test/automated/ert-x-tests.el
+++ b/test/automated/ert-x-tests.el
@@ -103,79 +103,79 @@
 
 (ert-deftest ert-test-run-tests-interactively-2 ()
   :tags '(:causes-redisplay)
-  (let ((passing-test (make-ert-test :name 'passing-test
-                                     :body (lambda () (ert-pass))))
-        (failing-test (make-ert-test :name 'failing-test
-                                     :body (lambda ()
-                                             (ert-info ((propertize "foo\nbar"
-                                                                    'a 'b))
-					      (ert-fail
-					       "failure message"))))))
-    (let ((ert-debug-on-error nil))
-      (let* ((buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
-             (messages nil)
-             (mock-message-fn
-              (lambda (format-string &rest args)
-                (push (apply #'format format-string args) messages))))
-        (flet ((expected-string (with-font-lock-p)
-                 (ert-propertized-string
-                  "Selector: (member <passing-test> <failing-test>)\n"
-                  "Passed: 1\n"
-                  "Failed: 1 (1 unexpected)\n"
-                  "Total:  2/2\n\n"
-                  "Started at:\n"
-                  "Finished.\n"
-                  "Finished at:\n\n"
-                  `(category ,(button-category-symbol
-                               'ert--results-progress-bar-button)
-                             button (t)
-                             face ,(if with-font-lock-p
-                                       'ert-test-result-unexpected
-                                     'button))
-                  ".F" nil "\n\n"
-                  `(category ,(button-category-symbol
-                               'ert--results-expand-collapse-button)
-                             button (t)
-                             face ,(if with-font-lock-p
-                                       'ert-test-result-unexpected
-                                     'button))
-                  "F" nil " "
-                  `(category ,(button-category-symbol
-                               'ert--test-name-button)
-                             button (t)
-                             ert-test-name failing-test)
-                  "failing-test"
-                  nil "\n    Info: " '(a b) "foo\n"
-                  nil "          " '(a b) "bar"
-                  nil "\n    (ert-test-failed \"failure message\")\n\n\n"
-                  )))
-        (save-window-excursion
-          (unwind-protect
-              (let ((case-fold-search nil))
-                (ert-run-tests-interactively
-                 `(member ,passing-test ,failing-test) buffer-name
-                 mock-message-fn)
-                (should (equal messages `(,(concat
-                                            "Ran 2 tests, 1 results were "
-                                            "as expected, 1 unexpected"))))
-                (with-current-buffer buffer-name
-                  (font-lock-mode 0)
-                  (should (ert-equal-including-properties
-                           (ert-filter-string (buffer-string)
-                                              '("Started at:\\(.*\\)$" 1)
-                                              '("Finished at:\\(.*\\)$" 1))
-                           (expected-string nil)))
-                  ;; `font-lock-mode' only works if interactive, so
-                  ;; pretend we are.
-                  (let ((noninteractive nil))
-                    (font-lock-mode 1))
-                  (should (ert-equal-including-properties
-                           (ert-filter-string (buffer-string)
-                                              '("Started at:\\(.*\\)$" 1)
-                                              '("Finished at:\\(.*\\)$" 1))
-                           (expected-string t)))))
-            (when (get-buffer buffer-name)
-              (kill-buffer buffer-name)))))))))
+  (let* ((passing-test (make-ert-test :name 'passing-test
+                                      :body (lambda () (ert-pass))))
+         (failing-test (make-ert-test :name 'failing-test
+                                      :body (lambda ()
+                                              (ert-info ((propertize "foo\nbar"
+                                                                     'a 'b))
+                                                (ert-fail
+                                                 "failure message")))))
+         (ert-debug-on-error nil)
+         (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
+         (messages nil)
+         (mock-message-fn
+          (lambda (format-string &rest args)
+            (push (apply #'format format-string args) messages))))
+    (cl-flet ((expected-string (with-font-lock-p)
+                (ert-propertized-string
+                 "Selector: (member <passing-test> <failing-test>)\n"
+                 "Passed: 1\n"
+                 "Failed: 1 (1 unexpected)\n"
+                 "Total:  2/2\n\n"
+                 "Started at:\n"
+                 "Finished.\n"
+                 "Finished at:\n\n"
+                 `(category ,(button-category-symbol
+                              'ert--results-progress-bar-button)
+                            button (t)
+                            face ,(if with-font-lock-p
+                                      'ert-test-result-unexpected
+                                    'button))
+                 ".F" nil "\n\n"
+                 `(category ,(button-category-symbol
+                              'ert--results-expand-collapse-button)
+                            button (t)
+                            face ,(if with-font-lock-p
+                                      'ert-test-result-unexpected
+                                    'button))
+                 "F" nil " "
+                 `(category ,(button-category-symbol
+                              'ert--test-name-button)
+                            button (t)
+                            ert-test-name failing-test)
+                 "failing-test"
+                 nil "\n    Info: " '(a b) "foo\n"
+                 nil "          " '(a b) "bar"
+                 nil "\n    (ert-test-failed \"failure message\")\n\n\n"
+                 )))
+      (save-window-excursion
+        (unwind-protect
+            (let ((case-fold-search nil))
+              (ert-run-tests-interactively
+               `(member ,passing-test ,failing-test) buffer-name
+               mock-message-fn)
+              (should (equal messages `(,(concat
+                                          "Ran 2 tests, 1 results were "
+                                          "as expected, 1 unexpected"))))
+              (with-current-buffer buffer-name
+                (font-lock-mode 0)
+                (should (ert-equal-including-properties
+                         (ert-filter-string (buffer-string)
+                                            '("Started at:\\(.*\\)$" 1)
+                                            '("Finished at:\\(.*\\)$" 1))
+                         (expected-string nil)))
+                ;; `font-lock-mode' only works if interactive, so
+                ;; pretend we are.
+                (let ((noninteractive nil))
+                  (font-lock-mode 1))
+                (should (ert-equal-including-properties
+                         (ert-filter-string (buffer-string)
+                                            '("Started at:\\(.*\\)$" 1)
+                                            '("Finished at:\\(.*\\)$" 1))
+                         (expected-string t)))))
+          (when (get-buffer buffer-name)
+            (kill-buffer buffer-name)))))))
 
 (ert-deftest ert-test-describe-test ()
   "Tests `ert-describe-test'."