Commit | Line | Data |
---|---|---|
6c075cd7 SM |
1 | ;;; lexbind-tests.el --- Testing the lexbind byte-compiler |
2 | ||
acaf905b | 3 | ;; Copyright (C) 2011-2012 Free Software Foundation, Inc. |
6c075cd7 SM |
4 | |
5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | |
7200d79c | 6 | ;; Keywords: |
6c075cd7 SM |
7 | |
8 | ;; This program is free software; you can redistribute it and/or modify | |
9 | ;; it under the terms of the GNU General Public License as published by | |
10 | ;; the Free Software Foundation, either version 3 of the License, or | |
11 | ;; (at your option) any later version. | |
12 | ||
13 | ;; This program is distributed in the hope that it will be useful, | |
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;; GNU General Public License for more details. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public License | |
19 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | ;;; Commentary: | |
22 | ||
7200d79c | 23 | ;; |
6c075cd7 SM |
24 | |
25 | ;;; Code: | |
26 | ||
27 | (require 'ert) | |
28 | ||
29 | (defconst lexbind-tests | |
30 | `( | |
31 | (let ((f #'car)) | |
32 | (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) | |
33 | (funcall f '(1 . 2)))) | |
34 | ) | |
35 | "List of expression for test. | |
36 | Each element will be executed by interpreter and with | |
37 | bytecompiled code, and their results compared.") | |
38 | ||
39 | ||
40 | ||
41 | (defun lexbind-check-1 (pat) | |
42 | "Return non-nil if PAT is the same whether directly evalled or compiled." | |
43 | (let ((warning-minimum-log-level :emergency) | |
44 | (byte-compile-warnings nil) | |
45 | (v0 (condition-case nil | |
46 | (eval pat t) | |
47 | (error nil))) | |
48 | (v1 (condition-case nil | |
49 | (funcall (let ((lexical-binding t)) | |
50 | (byte-compile `(lambda nil ,pat)))) | |
51 | (error nil)))) | |
52 | (equal v0 v1))) | |
53 | ||
54 | (put 'lexbind-check-1 'ert-explainer 'lexbind-explain-1) | |
55 | ||
56 | (defun lexbind-explain-1 (pat) | |
57 | (let ((v0 (condition-case nil | |
58 | (eval pat t) | |
59 | (error nil))) | |
60 | (v1 (condition-case nil | |
61 | (funcall (let ((lexical-binding t)) | |
62 | (byte-compile (list 'lambda nil pat)))) | |
63 | (error nil)))) | |
64 | (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." | |
65 | pat v0 v1))) | |
66 | ||
67 | (ert-deftest lexbind-tests () | |
68 | "Test the Emacs byte compiler lexbind handling." | |
69 | (dolist (pat lexbind-tests) | |
70 | (should (lexbind-check-1 pat)))) | |
71 | ||
72 | ||
73 | ||
74 | (provide 'lexbind-tests) | |
75 | ;;; lexbind-tests.el ends here |