X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a67c4ae05909874c97f86b11dcb8ddc88b3e960c..358a8b34ac954ca147de9ececa4a51a21e60c97e:/lisp/emacs-lisp/ert.el

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index a131f48c48..4ffd8cd855 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1,6 +1,6 @@
 ;;; ert.el --- Emacs Lisp Regression Testing  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2015 Free Software Foundation, Inc.
 
 ;; Author: Christian Ohler <ohler@gnu.org>
 ;; Keywords: lisp, tools
@@ -999,7 +999,8 @@ contained in UNIVERSE."
        (list (cl-remove-if-not (lambda (test)
                                    (and (ert-test-name test)
                                         (string-match selector
-                                                      (ert-test-name test))))
+                                                      (symbol-name
+                                                       (ert-test-name test)))))
                                  universe))))
     (ert-test (list selector))
     (symbol
@@ -1319,7 +1320,7 @@ RESULT must be an `ert-test-result-with-condition'."
         (unwind-protect
             (progn
               (insert message "\n")
-              (setq end (copy-marker (point)))
+              (setq end (point-marker))
               (goto-char begin)
               (insert "    " prefix)
               (forward-line 1)
@@ -1462,13 +1463,72 @@ the tests)."
       (kill-emacs 2))))
 
 
+(defun ert-summarize-tests-batch-and-exit ()
+  "Summarize the results of testing.
+Expects to be called in batch mode, with logfiles as command-line arguments.
+The logfiles should have the `ert-run-tests-batch' format.  When finished,
+this exits Emacs, with status as per `ert-run-tests-batch-and-exit'."
+  (or noninteractive
+      (user-error "This function is only for use in batch mode"))
+  (let ((nlogs (length command-line-args-left))
+        (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0)
+        nnotrun logfile notests badtests unexpected)
+    (with-temp-buffer
+      (while (setq logfile (pop command-line-args-left))
+        (erase-buffer)
+        (insert-file-contents logfile)
+        (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t))
+            (push logfile notests)
+          (setq ntests (+ ntests (string-to-number (match-string 1))))
+          (if (not (re-search-forward "^\\(Aborted: \\)?\
+Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
+\\(?:, \\([0-9]+\\) unexpected\\)?\
+\\(?:, \\([0-9]+\\) skipped\\)?" nil t))
+              (push logfile badtests)
+            (if (match-string 1) (push logfile badtests))
+            (setq nrun (+ nrun (string-to-number (match-string 2)))
+                  nexpected (+ nexpected (string-to-number (match-string 3))))
+            (when (match-string 4)
+              (push logfile unexpected)
+              (setq nunexpected (+ nunexpected
+                                   (string-to-number (match-string 4)))))
+            (if (match-string 5)
+                (setq nskipped (+ nskipped
+                                  (string-to-number (match-string 5)))))))))
+    (setq nnotrun (- ntests nrun))
+    (message "\nSUMMARY OF TEST RESULTS")
+    (message "-----------------------")
+    (message "Files examined: %d" nlogs)
+    (message "Ran %d tests%s, %d results as expected%s%s"
+             nrun
+             (if (zerop nnotrun) "" (format ", %d failed to run" nnotrun))
+             nexpected
+             (if (zerop nunexpected)
+                 ""
+               (format ", %d unexpected" nunexpected))
+             (if (zerop nskipped)
+                 ""
+               (format ", %d skipped" nskipped)))
+    (when notests
+      (message "%d files did not contain any tests:" (length notests))
+      (mapc (lambda (l) (message "  %s" l)) notests))
+    (when badtests
+      (message "%d files did not finish:" (length badtests))
+      (mapc (lambda (l) (message "  %s" l)) badtests))
+    (when unexpected
+      (message "%d files contained unexpected results:" (length unexpected))
+      (mapc (lambda (l) (message "  %s" l)) unexpected))
+    (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2)
+                      (unexpected 1)
+                      (t 0)))))
+
 ;;; Utility functions for load/unload actions.
 
 (defun ert--activate-font-lock-keywords ()
   "Activate font-lock keywords for some of ERT's symbols."
   (font-lock-add-keywords
    nil
-   '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\sw+\\)?"
+   '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
       (1 font-lock-keyword-face nil t)
       (2 font-lock-function-name-face nil t)))))
 
@@ -1881,11 +1941,12 @@ and how to display message."
                             ;; defined without cl.
                             (car ert--selector-history)
                           "t")))
-           (completing-read (if (null default)
-				"Run tests: "
-			      (format "Run tests (default %s): " default))
-			    obarray #'ert-test-boundp nil nil
-			    'ert--selector-history default nil))
+           (read
+            (completing-read (if (null default)
+                                 "Run tests: "
+                               (format "Run tests (default %s): " default))
+                             obarray #'ert-test-boundp nil nil
+                             'ert--selector-history default nil)))
          nil))
   (unless message-fn (setq message-fn 'message))
   (let ((output-buffer-name output-buffer-name)