;;; bytecomp-testsuite.el ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. ;; Author: Shigeru Fukaya ;; Created: November 2008 ;; Keywords: internal ;; Human-Keywords: internal ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: (require 'ert) ;;; Code: (defconst byte-opt-testsuite-arith-data '( ;; some functional tests (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c)) (let ((a most-positive-fixnum) (b -2) (c 1.0)) (- a b c)) (let ((a most-positive-fixnum) (b 2) (c 1.0)) (* a b c)) (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))) ;; 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)) (let ((a 1.0)) (/ 3 a 2)) (let ((a most-positive-fixnum) (b 2.0)) (* a 2 b)) (let ((a 3) (b 2)) (/ a b 1.0)) (/ 3 -1) (+ 4 3 2 1) (+ 4 3 2.0 1) (- 4 3 2 1) ; not new, for reference (- 4 3 2.0 1) ; not new, for reference (* 4 3 2 1) (* 4 3 2.0 1) (/ 4 3 2 1) (/ 4 3 2.0 1) (let ((a 3) (b 2)) (+ a b 1)) (let ((a 3) (b 2)) (+ a b -1)) (let ((a 3) (b 2)) (- a b 1)) (let ((a 3) (b 2)) (- a b -1)) (let ((a 3) (b 2)) (+ a b a 1)) (let ((a 3) (b 2)) (+ a b a -1)) (let ((a 3) (b 2)) (- a b a 1)) (let ((a 3) (b 2)) (- a b a -1)) (let ((a 3) (b 2)) (* a b -1)) (let ((a 3) (b 2)) (* a -1)) (let ((a 3) (b 2)) (/ a b 1)) (let ((a 3) (b 2)) (/ (+ a b) 1)) ;; coverage test (let ((a 3) (b 2) (c 1.0)) (+)) (let ((a 3) (b 2) (c 1.0)) (+ 2)) (let ((a 3) (b 2) (c 1.0)) (+ 2 0)) (let ((a 3) (b 2) (c 1.0)) (+ 2 0.0)) (let ((a 3) (b 2) (c 1.0)) (+ 2.0)) (let ((a 3) (b 2) (c 1.0)) (+ 2.0 0)) (let ((a 3) (b 2) (c 1.0)) (+ 2.0 0.0)) (let ((a 3) (b 2) (c 1.0)) (+ 0 2)) (let ((a 3) (b 2) (c 1.0)) (+ 0 2.0)) (let ((a 3) (b 2) (c 1.0)) (+ 0.0 2)) (let ((a 3) (b 2) (c 1.0)) (+ 0.0 2.0)) (let ((a 3) (b 2) (c 1.0)) (+ a)) (let ((a 3) (b 2) (c 1.0)) (+ a 0)) (let ((a 3) (b 2) (c 1.0)) (+ a 0.0)) (let ((a 3) (b 2) (c 1.0)) (+ 0 a)) (let ((a 3) (b 2) (c 1.0)) (+ 0.0 a)) (let ((a 3) (b 2) (c 1.0)) (+ c 0)) (let ((a 3) (b 2) (c 1.0)) (+ c 0.0)) (let ((a 3) (b 2) (c 1.0)) (+ 0 c)) (let ((a 3) (b 2) (c 1.0)) (+ 0.0 c)) (let ((a 3) (b 2) (c 1.0)) (+ a b 0 c 0)) (let ((a 3) (b 2) (c 1.0)) (+ 0 a)) (let ((a 3) (b 2) (c 1.0)) (+ 0 a b)) (let ((a 3) (b 2) (c 1.0)) (+ 0 a b c)) (let ((a 3) (b 2) (c 1.0)) (+ 1 2 3)) (let ((a 3) (b 2) (c 1.0)) (+ 3.0 2.0 1)) (let ((a 3) (b 2) (c 1.0)) (+ 3.0 2.0 1 4)) (let ((a 3) (b 2) (c 1.0)) (+ a 1)) (let ((a 3) (b 2) (c 1.0)) (+ a -1)) (let ((a 3) (b 2) (c 1.0)) (+ 1 a)) (let ((a 3) (b 2) (c 1.0)) (+ -1 a)) (let ((a 3) (b 2) (c 1.0)) (+ c 1)) (let ((a 3) (b 2) (c 1.0)) (+ c -1)) (let ((a 3) (b 2) (c 1.0)) (+ 1 c)) (let ((a 3) (b 2) (c 1.0)) (+ -1 c)) (let ((a 3) (b 2) (c 1.0)) (+ a b 0)) (let ((a 3) (b 2) (c 1.0)) (+ a b 1)) (let ((a 3) (b 2) (c 1.0)) (+ a b -1)) (let ((a 3) (b 2) (c 1.0)) (+ a b 2)) (let ((a 3) (b 2) (c 1.0)) (+ 1 a b c)) (let ((a 3) (b 2) (c 1.0)) (+ a b c 0)) (let ((a 3) (b 2) (c 1.0)) (+ a b c 1)) (let ((a 3) (b 2) (c 1.0)) (+ a b c -1)) (let ((a 3) (b 2) (c 1.0)) (-)) (let ((a 3) (b 2) (c 1.0)) (- 2)) (let ((a 3) (b 2) (c 1.0)) (- 2 0)) (let ((a 3) (b 2) (c 1.0)) (- 2 0.0)) (let ((a 3) (b 2) (c 1.0)) (- 2.0)) (let ((a 3) (b 2) (c 1.0)) (- 2.0 0)) (let ((a 3) (b 2) (c 1.0)) (- 2.0 0.0)) (let ((a 3) (b 2) (c 1.0)) (- 0 2)) (let ((a 3) (b 2) (c 1.0)) (- 0 2.0)) (let ((a 3) (b 2) (c 1.0)) (- 0.0 2)) (let ((a 3) (b 2) (c 1.0)) (- 0.0 2.0)) (let ((a 3) (b 2) (c 1.0)) (- a)) (let ((a 3) (b 2) (c 1.0)) (- a 0)) (let ((a 3) (b 2) (c 1.0)) (- a 0.0)) (let ((a 3) (b 2) (c 1.0)) (- 0 a)) (let ((a 3) (b 2) (c 1.0)) (- 0.0 a)) (let ((a 3) (b 2) (c 1.0)) (- c 0)) (let ((a 3) (b 2) (c 1.0)) (- c 0.0)) (let ((a 3) (b 2) (c 1.0)) (- 0 c)) (let ((a 3) (b 2) (c 1.0)) (- 0.0 c)) (let ((a 3) (b 2) (c 1.0)) (- a b 0 c 0)) (let ((a 3) (b 2) (c 1.0)) (- 0 a)) (let ((a 3) (b 2) (c 1.0)) (- 0 a b)) (let ((a 3) (b 2) (c 1.0)) (- 0 a b c)) (let ((a 3) (b 2) (c 1.0)) (- 1 2 3)) (let ((a 3) (b 2) (c 1.0)) (- 3.0 2.0 1)) (let ((a 3) (b 2) (c 1.0)) (- 3.0 2.0 1 4)) (let ((a 3) (b 2) (c 1.0)) (- a 1)) (let ((a 3) (b 2) (c 1.0)) (- a -1)) (let ((a 3) (b 2) (c 1.0)) (- 1 a)) (let ((a 3) (b 2) (c 1.0)) (- -1 a)) (let ((a 3) (b 2) (c 1.0)) (- c 1)) (let ((a 3) (b 2) (c 1.0)) (- c -1)) (let ((a 3) (b 2) (c 1.0)) (- 1 c)) (let ((a 3) (b 2) (c 1.0)) (- -1 c)) (let ((a 3) (b 2) (c 1.0)) (- a b 0)) (let ((a 3) (b 2) (c 1.0)) (- a b 1)) (let ((a 3) (b 2) (c 1.0)) (- a b -1)) (let ((a 3) (b 2) (c 1.0)) (- a b 2)) (let ((a 3) (b 2) (c 1.0)) (- 1 a b c)) (let ((a 3) (b 2) (c 1.0)) (- a b c 0)) (let ((a 3) (b 2) (c 1.0)) (- a b c 1)) (let ((a 3) (b 2) (c 1.0)) (- a b c -1)) (let ((a 3) (b 2) (c 1.0)) (*)) (let ((a 3) (b 2) (c 1.0)) (* 2)) (let ((a 3) (b 2) (c 1.0)) (* 2 0)) (let ((a 3) (b 2) (c 1.0)) (* 2 0.0)) (let ((a 3) (b 2) (c 1.0)) (* 2.0)) (let ((a 3) (b 2) (c 1.0)) (* 2.0 0)) (let ((a 3) (b 2) (c 1.0)) (* 2.0 0.0)) (let ((a 3) (b 2) (c 1.0)) (* 0 2)) (let ((a 3) (b 2) (c 1.0)) (* 0 2.0)) (let ((a 3) (b 2) (c 1.0)) (* 0.0 2)) (let ((a 3) (b 2) (c 1.0)) (* 0.0 2.0)) (let ((a 3) (b 2) (c 1.0)) (* a)) (let ((a 3) (b 2) (c 1.0)) (* a 0)) (let ((a 3) (b 2) (c 1.0)) (* a 0.0)) (let ((a 3) (b 2) (c 1.0)) (* 0 a)) (let ((a 3) (b 2) (c 1.0)) (* 0.0 a)) (let ((a 3) (b 2) (c 1.0)) (* c 0)) (let ((a 3) (b 2) (c 1.0)) (* c 0.0)) (let ((a 3) (b 2) (c 1.0)) (* 0 c)) (let ((a 3) (b 2) (c 1.0)) (* 0.0 c)) (let ((a 3) (b 2) (c 1.0)) (* a b 0 c 0)) (let ((a 3) (b 2) (c 1.0)) (* 0 a)) (let ((a 3) (b 2) (c 1.0)) (* 0 a b)) (let ((a 3) (b 2) (c 1.0)) (* 0 a b c)) (let ((a 3) (b 2) (c 1.0)) (* 1 2 3)) (let ((a 3) (b 2) (c 1.0)) (* 3.0 2.0 1)) (let ((a 3) (b 2) (c 1.0)) (* 3.0 2.0 1 4)) (let ((a 3) (b 2) (c 1.0)) (* a 1)) (let ((a 3) (b 2) (c 1.0)) (* a -1)) (let ((a 3) (b 2) (c 1.0)) (* 1 a)) (let ((a 3) (b 2) (c 1.0)) (* -1 a)) (let ((a 3) (b 2) (c 1.0)) (* c 1)) (let ((a 3) (b 2) (c 1.0)) (* c -1)) (let ((a 3) (b 2) (c 1.0)) (* 1 c)) (let ((a 3) (b 2) (c 1.0)) (* -1 c)) (let ((a 3) (b 2) (c 1.0)) (* a b 0)) (let ((a 3) (b 2) (c 1.0)) (* a b 1)) (let ((a 3) (b 2) (c 1.0)) (* a b -1)) (let ((a 3) (b 2) (c 1.0)) (* a b 2)) (let ((a 3) (b 2) (c 1.0)) (* 1 a b c)) (let ((a 3) (b 2) (c 1.0)) (* a b c 0)) (let ((a 3) (b 2) (c 1.0)) (* a b c 1)) (let ((a 3) (b 2) (c 1.0)) (* a b c -1)) (let ((a 3) (b 2) (c 1.0)) (/)) (let ((a 3) (b 2) (c 1.0)) (/ 2)) (let ((a 3) (b 2) (c 1.0)) (/ 2 0)) (let ((a 3) (b 2) (c 1.0)) (/ 2 0.0)) (let ((a 3) (b 2) (c 1.0)) (/ 2.0)) (let ((a 3) (b 2) (c 1.0)) (/ 2.0 0)) (let ((a 3) (b 2) (c 1.0)) (/ 2.0 0.0)) (let ((a 3) (b 2) (c 1.0)) (/ 0 2)) (let ((a 3) (b 2) (c 1.0)) (/ 0 2.0)) (let ((a 3) (b 2) (c 1.0)) (/ 0.0 2)) (let ((a 3) (b 2) (c 1.0)) (/ 0.0 2.0)) (let ((a 3) (b 2) (c 1.0)) (/ a)) (let ((a 3) (b 2) (c 1.0)) (/ a 0)) (let ((a 3) (b 2) (c 1.0)) (/ a 0.0)) (let ((a 3) (b 2) (c 1.0)) (/ 0 a)) (let ((a 3) (b 2) (c 1.0)) (/ 0.0 a)) (let ((a 3) (b 2) (c 1.0)) (/ c 0)) (let ((a 3) (b 2) (c 1.0)) (/ c 0.0)) (let ((a 3) (b 2) (c 1.0)) (/ 0 c)) (let ((a 3) (b 2) (c 1.0)) (/ 0.0 c)) (let ((a 3) (b 2) (c 1.0)) (/ a b 0 c 0)) (let ((a 3) (b 2) (c 1.0)) (/ 0 a)) (let ((a 3) (b 2) (c 1.0)) (/ 0 a b)) (let ((a 3) (b 2) (c 1.0)) (/ 0 a b c)) (let ((a 3) (b 2) (c 1.0)) (/ 1 2 3)) (let ((a 3) (b 2) (c 1.0)) (/ 3.0 2.0 1)) (let ((a 3) (b 2) (c 1.0)) (/ 3.0 2.0 1 4)) (let ((a 3) (b 2) (c 1.0)) (/ a 1)) (let ((a 3) (b 2) (c 1.0)) (/ a -1)) (let ((a 3) (b 2) (c 1.0)) (/ 1 a)) (let ((a 3) (b 2) (c 1.0)) (/ -1 a)) (let ((a 3) (b 2) (c 1.0)) (/ c 1)) (let ((a 3) (b 2) (c 1.0)) (/ c -1)) (let ((a 3) (b 2) (c 1.0)) (/ 1 c)) (let ((a 3) (b 2) (c 1.0)) (/ -1 c)) (let ((a 3) (b 2) (c 1.0)) (/ a b 0)) (let ((a 3) (b 2) (c 1.0)) (/ a b 1)) (let ((a 3) (b 2) (c 1.0)) (/ a b -1)) (let ((a 3) (b 2) (c 1.0)) (/ a b 2)) (let ((a 3) (b 2) (c 1.0)) (/ 1 a b c)) (let ((a 3) (b 2) (c 1.0)) (/ a b c 0)) (let ((a 3) (b 2) (c 1.0)) (/ a b c 1)) (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 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") (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) (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)