From ef59bce210700ffb9d975081868db5a180887f38 Mon Sep 17 00:00:00 2001 From: Phil Jackson Date: Fri, 8 Aug 2008 16:46:39 +0100 Subject: [PATCH] Meta-info now pretty printing in results buffer. --- etest-execute.el | 3 +- etest-result-mode.el | 53 +++++++++++++++++++++++++++------- etest.el | 81 ++++++++++++++++++++++++++-------------------------- 3 files changed, 85 insertions(+), 52 deletions(-) diff --git a/etest-execute.el b/etest-execute.el index 8a0ffec..138e997 100644 --- a/etest-execute.el +++ b/etest-execute.el @@ -39,8 +39,7 @@ `etest-file'. Then checking `etest-load-path' for a similarly named (to the buffer) file. Then looking in `default-directory'." (cond - ((and etest-file - (file-exists-p (expand-file-name etest-file))) + ((and etest-file (file-exists-p (expand-file-name etest-file))) (expand-file-name etest-file)) ((and buffer-file-name (catch 'found diff --git a/etest-result-mode.el b/etest-result-mode.el index 2e98a77..1eff4ac 100644 --- a/etest-result-mode.el +++ b/etest-result-mode.el @@ -49,13 +49,19 @@ "\\)") "Regexp that will match a test status.") +(defvar etest-meta-info-re + (concat "[[:blank:]]" + (regexp-opt '("total" + "pass" + "fail" + "started" + "finished") t) + "..\\{2,\\}[[:blank:]]+\\(.+\\)$") + "Regexp that will match the stats at the bottom of the buffer.") + (defvar etest-rm-map (let ((m (make-keymap))) (define-key m (kbd "q") 'bury-buffer) - (define-key m (kbd "g") - '(lambda () - (interactive) - (etest-rm-refresh-buffer current-results))) (define-key m (kbd "#") 'etest-rm-cycle-comments) (define-key m (kbd "TAB") 'etest-rm-toggle-headline) (define-key m (kbd "") 'etest-rm-toggle-headline) @@ -98,17 +104,20 @@ current line." (etest-rm-count-string-at-bol "*")))) ;;;###autoload -(defun etest-result-mode (&optional results) +(defun etest-result-mode (&optional results meta-info) "Mode used to display test results." (interactive) (kill-all-local-variables) (setq buffer-read-only t) (outline-minor-mode) (set (make-local-variable 'outline-regexp) - (concat "\\(\\*\\|" etest-status-re "\\)")) + (concat "\\(\\*\\|" + etest-status-re "\\|" + etest-meta-info-re "\\)")) (set (make-local-variable 'outline-level) 'etest-rm-outline-level) (set (make-local-variable 'current-results) results) + (set (make-local-variable 'current-meta-info) meta-info) (setq major-mode 'etest-result-mode) (setq mode-name "etest-result") (set (make-local-variable 'font-lock-defaults) @@ -153,15 +162,38 @@ current line." (when (cdr results) (etest-rm-pretty-print-results (cdr results) level)))) -(defun etest-rm-refresh-buffer (results stats) +(defun etest-rm-pretty-print-meta-info (meta-info) + "Insert a few details about the pass rate." + (let* ((pass (float (plist-get meta-info :pass))) + (fail (float (plist-get meta-info :fail))) + (total (+ pass fail)) + (start (plist-get meta-info :timestart)) + (finish (plist-get meta-info :timefinish))) + (insert (format (concat "\n total ..... %3d\n" + " pass ...... %3d (%3d%%)\n" + " fail ...... %3d (%3d%%)") + total + pass + (* (/ pass total) 100) + fail + (* (/ fail total) 100))) + (insert (format (concat "\n started ... %s\n" + " finished .. %s (%f seconds)\n") + (current-time-string start) + (current-time-string finish) + (- (float-time finish) (float-time start)))))) + + +(defun etest-rm-refresh-buffer (results &optional meta-info) "Refresh the results buffer using the cached test results." (save-selected-window (switch-to-buffer-other-window (get-buffer-create "*etest*")) (setq buffer-read-only nil) (erase-buffer) - (insert (pp stats)) (etest-rm-pretty-print-results results 0) - (etest-result-mode results) + (when meta-info + (etest-rm-pretty-print-meta-info meta-info)) + (etest-result-mode results meta-info) (goto-char (point-min)) (when (search-forward-regexp etest-rm-not-ok-re nil t) (goto-char (point-at-bol))))) @@ -193,6 +225,7 @@ current line." (defconst etest-rm-font-lock-keywords `((,etest-rm-ok-re 1 etest-rm-ok-face) (,etest-rm-not-ok-re 1 etest-rm-not-ok-face) + (,etest-meta-info-re 1 etest-rm-heading-face) ("^ *\\(#.+\\)" 1 etest-rm-comment-face) ("^ *\\*+ \\(.+\\)" 1 etest-rm-heading-face))) @@ -216,7 +249,7 @@ comments." (concatenate 'list (cdr etest-rm-comment-visibility-types) (list (car etest-rm-comment-visibility-types)))) - (etest-rm-refresh-buffer current-results) + (etest-rm-refresh-buffer current-results current-meta-info) (message (format "%S" (car etest-rm-comment-visibility-types)))) (defmacro etest-with-comments (&rest body) diff --git a/etest.el b/etest.el index 6057a75..ddd07a4 100644 --- a/etest.el +++ b/etest.el @@ -166,7 +166,7 @@ FUNC. Returns a test result." (match nil) (re (eval re)) (string (eval form)) - (comments (format " needle: '%s'\nhaystack: '%s'" re string)) + (comments (format " needle: '%s'\nhaystack: '%s'\n" re string)) (res (not (not (string-match re string)))) (result (list :result res))) (while (setq match (match-string (setq i (1+ i)) string)) @@ -179,52 +179,53 @@ FUNC. Returns a test result." (defmacro etest (&rest form) "Wrapper to `etest-run'. Will popup a window displaying the results of the run." - `(let* ((stats (list :pass 0 - :fail 0 - :timestart (current-time) - :timefinish 0)) - (results (etest-run ',form stats))) + `(let* ((meta-info (list :pass 0 + :fail 0 + :timestart (current-time) + :timefinish 0)) + (results (etest-run ',form meta-info))) + (plist-put meta-info :timefinish (current-time)) (when (fboundp etest-results-function) - (funcall etest-results-function results stats)) + (funcall etest-results-function results meta-info)) results)) -(defun etest-run (form &optional stats) +(defun etest-run (form &optional meta-info) "This function does all of the work where actually running the tests is concerned. Takes a valid etest form and will return a similarly shaped set of results. " - (let ((all (mapcar - '(lambda (test) - (let ((name (car test))) - (cond - ((stringp name) - (cons name (etest-run (cdr test) stats))) - ((symbolp name) - (let ((cand (car (plist-get etest-candidates-plist name))) - (args (cdr test)) - (argcount (cadr (plist-get etest-candidates-plist name))) - (doc nil)) - (unless cand - (error "'%s' is not a valid name type" name)) - (if (< (length args) argcount) - (error "%s needs %d arguments" cand argcount) - (if (and (eq (length args) (1+ argcount)) - (stringp (car (last args)))) - (progn - (setq doc (car (last args))) - (setq args (delq doc args))) - (setq doc (prin1-to-string test)))) - (let ((results (apply cand args))) - (plist-put results :doc doc) - (when stats - (etest-stats-update results stats)) - results)))))) - form))) - (plist-put stats :timefinish (current-time)) - all)) - -(defun etest-stats-update (result stats) + (mapcar + '(lambda (test) + (let ((name (car test))) + (cond + ((stringp name) + (cons name (etest-run (cdr test) meta-info))) + ((symbolp name) + (let ((cand (car (plist-get etest-candidates-plist name))) + (args (cdr test)) + (argcount (cadr (plist-get etest-candidates-plist name))) + (doc nil)) + (unless cand + (error "'%s' is not a valid name type" name)) + (if (< (length args) argcount) + (error "%s needs %d arguments" cand argcount) + (if (and (eq (length args) (1+ argcount)) + (stringp (car (last args)))) + (progn + (setq doc (car (last args))) + (setq args (delq doc args))) + (setq doc (prin1-to-string test)))) + (let ((results (apply cand args))) + (plist-put results :doc doc) + (when meta-info + (etest-meta-info-update-pass-fail results meta-info)) + results)))))) + form)) + +(defun etest-meta-info-update-pass-fail (result meta-info) + "Update the pass/fail item in the meta-info plist based on the +resuls in RESULT." (let ((type (if (plist-get result :result) :pass :fail))) - (plist-put stats type (1+ (plist-get stats type))))) + (plist-put meta-info type (1+ (plist-get meta-info type))))) ;; This is defined so that etest can test itself (defun etest-test-tests (test result) -- 2.11.4.GIT