From: Eli Zaretskii Date: Sat, 24 Sep 2016 08:55:03 +0000 (+0300) Subject: ; * test/lisp/bytecomp-tests.el: Moved from test/lisp/legacy/. X-Git-Tag: emacs-26.0.90~1569 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=90351d98b6ebc079e81c7a788c0e7fe66c888f2b;p=emacs.git ; * test/lisp/bytecomp-tests.el: Moved from test/lisp/legacy/. --- diff --git a/test/lisp/bytecomp-tests.el b/test/lisp/bytecomp-tests.el new file mode 100644 index 00000000000..1e076a7a472 --- /dev/null +++ b/test/lisp/bytecomp-tests.el @@ -0,0 +1,428 @@ +;;; bytecomp-testsuite.el + +;; Copyright (C) 2008-2016 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")))) + +(defun test-byte-comp-compile-and-load (compile &rest forms) + (let ((elfile nil) + (elcfile nil)) + (unwind-protect + (progn + (setf elfile (make-temp-file "test-bytecomp" nil ".el")) + (when compile + (setf elcfile (make-temp-file "test-bytecomp" nil ".elc"))) + (with-temp-buffer + (dolist (form forms) + (print form (current-buffer))) + (write-region (point-min) (point-max) elfile nil 'silent)) + (if compile + (let ((byte-compile-dest-file-function + (lambda (e) elcfile))) + (byte-compile-file elfile t)) + (load elfile nil 'nomessage))) + (when elfile (delete-file elfile)) + (when elcfile (delete-file elcfile))))) +(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1) + +(ert-deftest test-byte-comp-macro-expansion () + (test-byte-comp-compile-and-load t + '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) + (should (equal (funcall 'def) 1))) + +(ert-deftest test-byte-comp-macro-expansion-eval-and-compile () + (test-byte-comp-compile-and-load t + '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) + (should (equal (funcall 'def) -1))) + +(ert-deftest test-byte-comp-macro-expansion-eval-when-compile () + ;; Make sure we interpret eval-when-compile forms properly. CLISP + ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) + ;; in the same way. + (test-byte-comp-compile-and-load t + '(eval-when-compile + (defmacro abc (arg) -10) + (defun abc-1 () (abc 2))) + '(defmacro abc-2 () (abc-1)) + '(defun def () (abc-2))) + (should (equal (funcall 'def) -10))) + +(ert-deftest test-byte-comp-macro-expand-lexical-override () + ;; Intuitively, one might expect the defmacro to override the + ;; macrolet since macrolet's is explicitly called out as being + ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form + ;; this way, so we should too. + (test-byte-comp-compile-and-load t + '(require 'cl-lib) + '(cl-macrolet ((m () 4)) + (defmacro m () 5) + (defun def () (m)))) + (should (equal (funcall 'def) 4))) + +(ert-deftest bytecomp-tests--warnings () + (with-current-buffer (get-buffer-create "*Compile-Log*") + (let ((inhibit-read-only t)) (erase-buffer))) + (test-byte-comp-compile-and-load t + '(progn + (defun my-test0 () + (my--test11 3) + (my--test12 3) + (my--test2 5)) + (defmacro my--test11 (arg) (+ arg 1)) + (eval-and-compile + (defmacro my--test12 (arg) (+ arg 1)) + (defun my--test2 (arg) (+ arg 1))))) + (with-current-buffer (get-buffer-create "*Compile-Log*") + (goto-char (point-min)) + ;; Should warn that mt--test1[12] are first used as functions. + ;; The second alternative is for when the file name is so long + ;; that pretty-printing starts the message on the next line. + (should (or (re-search-forward "my--test11:\n.*macro" nil t) + (re-search-forward "my--test11:\n.*:\n.*macro" nil t))) + (should (or (re-search-forward "my--test12:\n.*macro" nil t) + (re-search-forward "my--test12:\n.*:\n.*macro" nil t))) + (goto-char (point-min)) + ;; Should not warn that mt--test2 is not known to be defined. + (should-not (re-search-forward "my--test2" nil t)))) + +(ert-deftest test-eager-load-macro-expansion () + (test-byte-comp-compile-and-load nil + '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) + (should (equal (funcall 'def) 1))) + +(ert-deftest test-eager-load-macro-expansion-eval-and-compile () + (test-byte-comp-compile-and-load nil + '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) + (should (equal (funcall 'def) -1))) + +(ert-deftest test-eager-load-macro-expansion-eval-when-compile () + ;; Make sure we interpret eval-when-compile forms properly. CLISP + ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) + ;; in the same way. + (test-byte-comp-compile-and-load nil + '(eval-when-compile + (defmacro abc (arg) -10) + (defun abc-1 () (abc 2))) + '(defmacro abc-2 () (abc-1)) + '(defun def () (abc-2))) + (should (equal (funcall 'def) -10))) + +(ert-deftest test-eager-load-macro-expand-lexical-override () + ;; Intuitively, one might expect the defmacro to override the + ;; macrolet since macrolet's is explicitly called out as being + ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form + ;; this way, so we should too. + (test-byte-comp-compile-and-load nil + '(require 'cl-lib) + '(cl-macrolet ((m () 4)) + (defmacro m () 5) + (defun def () (m)))) + (should (equal (funcall 'def) 4))) + + +;; Local Variables: +;; no-byte-compile: t +;; End: + +(provide 'byte-opt-testsuite) diff --git a/test/lisp/legacy/bytecomp-tests.el b/test/lisp/legacy/bytecomp-tests.el deleted file mode 100644 index 48211f03ba4..00000000000 --- a/test/lisp/legacy/bytecomp-tests.el +++ /dev/null @@ -1,429 +0,0 @@ -;;; bytecomp-testsuite.el - -;; Copyright (C) 2008-2016 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")))) - -(defun test-byte-comp-compile-and-load (compile &rest forms) - (let ((elfile nil) - (elcfile nil)) - (unwind-protect - (progn - (setf elfile (make-temp-file "test-bytecomp" nil ".el")) - (when compile - (setf elcfile (make-temp-file "test-bytecomp" nil ".elc"))) - (with-temp-buffer - (dolist (form forms) - (print form (current-buffer))) - (write-region (point-min) (point-max) elfile nil 'silent)) - (if compile - (let ((byte-compile-dest-file-function - (lambda (e) elcfile))) - (byte-compile-file elfile t)) - (load elfile nil 'nomessage))) - (when elfile (delete-file elfile)) - (when elcfile (delete-file elcfile))))) -(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1) - -(ert-deftest test-byte-comp-macro-expansion () - (test-byte-comp-compile-and-load t - '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) - (should (equal (funcall 'def) 1))) - -(ert-deftest test-byte-comp-macro-expansion-eval-and-compile () - (test-byte-comp-compile-and-load t - '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) - (should (equal (funcall 'def) -1))) - -(ert-deftest test-byte-comp-macro-expansion-eval-when-compile () - ;; Make sure we interpret eval-when-compile forms properly. CLISP - ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) - ;; in the same way. - (test-byte-comp-compile-and-load t - '(eval-when-compile - (defmacro abc (arg) -10) - (defun abc-1 () (abc 2))) - '(defmacro abc-2 () (abc-1)) - '(defun def () (abc-2))) - (should (equal (funcall 'def) -10))) - -(ert-deftest test-byte-comp-macro-expand-lexical-override () - ;; Intuitively, one might expect the defmacro to override the - ;; macrolet since macrolet's is explicitly called out as being - ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form - ;; this way, so we should too. - (test-byte-comp-compile-and-load t - '(require 'cl-lib) - '(cl-macrolet ((m () 4)) - (defmacro m () 5) - (defun def () (m)))) - (should (equal (funcall 'def) 4))) - -(ert-deftest bytecomp-tests--warnings () - (with-current-buffer (get-buffer-create "*Compile-Log*") - (let ((inhibit-read-only t)) (erase-buffer))) - (test-byte-comp-compile-and-load t - '(progn - (defun my-test0 () - (my--test11 3) - (my--test12 3) - (my--test2 5)) - (defmacro my--test11 (arg) (+ arg 1)) - (eval-and-compile - (defmacro my--test12 (arg) (+ arg 1)) - (defun my--test2 (arg) (+ arg 1))))) - (with-current-buffer (get-buffer-create "*Compile-Log*") - (goto-char (point-min)) - ;; Should warn that mt--test1[12] are first used as functions. - ;; The second alternative is for when the file name is so long - ;; that pretty-printing starts the message on the next line. - (should (or (re-search-forward "my--test11:\n.*macro" nil t) - (re-search-forward "my--test11:\n.*:\n.*macro" nil t))) - (should (or (re-search-forward "my--test12:\n.*macro" nil t) - (re-search-forward "my--test12:\n.*:\n.*macro" nil t))) - (goto-char (point-min)) - ;; Should not warn that mt--test2 is not known to be defined. - (should-not (re-search-forward "my--test2" nil t)))) - -(ert-deftest test-eager-load-macro-expansion () - (test-byte-comp-compile-and-load nil - '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) - (should (equal (funcall 'def) 1))) - -(ert-deftest test-eager-load-macro-expansion-eval-and-compile () - (test-byte-comp-compile-and-load nil - '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) - (should (equal (funcall 'def) -1))) - -(ert-deftest test-eager-load-macro-expansion-eval-when-compile () - ;; Make sure we interpret eval-when-compile forms properly. CLISP - ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) - ;; in the same way. - (test-byte-comp-compile-and-load nil - '(eval-when-compile - (defmacro abc (arg) -10) - (defun abc-1 () (abc 2))) - '(defmacro abc-2 () (abc-1)) - '(defun def () (abc-2))) - (should (equal (funcall 'def) -10))) - -(ert-deftest test-eager-load-macro-expand-lexical-override () - ;; Intuitively, one might expect the defmacro to override the - ;; macrolet since macrolet's is explicitly called out as being - ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form - ;; this way, so we should too. - (test-byte-comp-compile-and-load nil - '(require 'cl-lib) - '(cl-macrolet ((m () 4)) - (defmacro m () 5) - (defun def () (m)))) - (should (equal (funcall 'def) 4))) - - -;; Local Variables: -;; no-byte-compile: t -;; End: - -(provide 'byte-opt-testsuite) -