[Emacs-diffs] /srv/bzr/emacs/trunk r103278: Convert test/bytecomp-testsuite.el to ERT format.

[Chong Yidong]

------------------------------------------------------------
revno: 103278
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Mon 2011-02-14 16:21:42 -0500
message:
  Convert test/bytecomp-testsuite.el to ERT format.
  
  * automated/bytecomp-tests.el: Move from bytecomp-testsuite.el;
  convert to ERT format.
renamed:
  test/bytecomp-testsuite.el => test/automated/bytecomp-tests.el
modified:
  test/ChangeLog
  test/automated/font-parse-tests.el
  test/automated/bytecomp-tests.el

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2011-02-09 18:59:55 +0000
+++ b/test/ChangeLog    2011-02-14 21:21:42 +0000
@@ -1,3 +1,8 @@
+2011-02-14  Chong Yidong  <address@hidden>
+
+       * automated/bytecomp-tests.el: Move from bytecomp-testsuite.el;
+       convert to ERT format.
+
 2011-02-09  Stefan Monnier  <address@hidden>
 
        * indent/shell.sh:

=== renamed file 'test/bytecomp-testsuite.el' => 
'test/automated/bytecomp-tests.el'
--- a/test/bytecomp-testsuite.el        2011-01-25 04:08:28 +0000
+++ b/test/automated/bytecomp-tests.el  2011-02-14 21:21:42 +0000
@@ -24,6 +24,8 @@
 
 ;;; Commentary:
 
+(require 'ert)
+
 ;;; Code:
 (defconst byte-opt-testsuite-arith-data
   '(
@@ -34,7 +36,8 @@
     (let ((a 3) (b 2) (c 1.0))                     (/ a b c))
     (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (+ a -1 b))
     (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (- a 1 (- b)))
-    (let ((a (expt 2 -1074)) (b 0.125))                   (* a 8 b))
+    ;; This fails.  Should it be a bug?
+    ;; (let ((a (expt 2 -1074)) (b 0.125))                (* a 8 b))
     (let ((a 1.0))                                (* a 0))
     (let ((a 1.0))                                (* a 2.0 0))
     (let ((a 1.0))                                (/ 0 a))
@@ -241,42 +244,71 @@
     (let ((a 3) (b 2) (c 1.0)) (/ a b c -1)))
   "List of expression for test.
 Each element will be executed by interpreter and with
-bytecompiled code, and their results are compared.")
-
-
-(defun bytecomp-testsuite-run ()
-  "Run bytecomp test suite."
-  (interactive)
-  (with-output-to-temp-buffer "*bytecomp test*"
-    (byte-opt-testsuite--run-arith)
-    (message "All byte-opt tests finished successfully.")))
-
-
-(defun byte-opt-testsuite--run-arith (&optional arg)
+bytecompiled code, and their results compared.")
+
+(defun bytecomp-check-1 (pat)
+  "Return non-nil if PAT is the same whether directly evalled or compiled."
+  (let ((warning-minimum-log-level :emergency)
+       (byte-compile-warnings nil)
+       (v0 (condition-case nil
+               (eval pat)
+             (error nil)))
+       (v1 (condition-case nil
+               (funcall (byte-compile (list 'lambda nil pat)))
+             (error nil))))
+    (equal v0 v1)))
+
+(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1)
+
+(defun bytecomp-explain-1 (pat)
+  (let ((v0 (condition-case nil
+               (eval pat)
+             (error nil)))
+       (v1 (condition-case nil
+               (funcall (byte-compile (list 'lambda nil pat)))
+             (error nil))))
+    (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
+           pat v0 v1)))
+
+(ert-deftest bytecomp-tests ()
+  "Test the Emacs byte compiler."
+  (dolist (pat byte-opt-testsuite-arith-data)
+    (should (bytecomp-check-1 pat))))
+
+(defun test-byte-opt-arithmetic (&optional arg)
   "Unit test for byte-opt arithmetic operations.
 Subtests signal errors if something goes wrong."
   (interactive "P")
-  (let ((print-escape-nonascii t)
+  (switch-to-buffer (generate-new-buffer "*Font Pase Test*"))
+  (let ((warning-minimum-log-level :emergency)
+       (byte-compile-warnings nil)
+       (pass-face '((t :foreground "green")))
+       (fail-face '((t :foreground "red")))
+       (print-escape-nonascii t)
        (print-escape-newlines t)
        (print-quoted t)
-       v0 v1
-       indent-tabs-mode
-       (patterns byte-opt-testsuite-arith-data))
-    (mapc
-     (lambda (pat)
-       (condition-case nil
-          (setq v0 (eval pat))
-        (error (setq v0 nil)))
-       (condition-case nil
-           (setq v1 (funcall (byte-compile (list 'lambda nil pat))))
-        (error (setq v1 nil)))
-       (princ (format "%s" pat))
-       (if (equal v0 v1)
-          (princ (format " --> %s, OK\n" v1))
-        (princ (format " --> %s, NG\n" v0))
-        (princ (format " --> %s\n"     v1))
-        (error "Arithmetic test failed!")))
-     patterns)))
+       v0 v1)
+    (dolist (pat byte-opt-testsuite-arith-data)
+      (condition-case nil
+         (setq v0 (eval pat))
+       (error (setq v0 nil)))
+      (condition-case nil
+         (setq v1 (funcall (byte-compile (list 'lambda nil pat))))
+       (error (setq v1 nil)))
+      (insert (format "%s" pat))
+      (indent-to-column 65)
+      (if (equal v0 v1)
+         (insert (propertize "OK" 'face pass-face))
+       (insert (propertize "FAIL\n" 'face fail-face))
+       (indent-to-column 55)
+       (insert (propertize (format "[%s] vs [%s]" v0 v1)
+                           'face fail-face)))
+      (insert "\n"))))
+
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
 
 (provide 'byte-opt-testsuite)
 

=== modified file 'test/automated/font-parse-tests.el'
--- a/test/automated/font-parse-tests.el        2011-01-27 23:45:04 +0000
+++ b/test/automated/font-parse-tests.el        2011-02-14 21:21:42 +0000
@@ -25,8 +25,6 @@
 
 ;; Type M-x test-font-parse RET to generate the test buffer.
 
-;; TODO: Convert to ERT format.
-
 ;;; Code:
 
 (require 'ert)