summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/emacs-lisp/byte-opt.el50
-rw-r--r--lisp/emacs-lisp/bytecomp.el265
-rw-r--r--lisp/emacs-lisp/disass.el18
-rw-r--r--src/bytecode.c39
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el19
5 files changed, 343 insertions, 48 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 13f885448ae..38f5dcc993b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -185,6 +185,7 @@
(require 'bytecomp)
(eval-when-compile (require 'cl-lib))
(require 'macroexp)
+(require 'subr-x)
(defun byte-compile-log-lap-1 (format &rest args)
;; Newer byte codes for stack-ref make the slot 0 non-nil again.
@@ -1356,7 +1357,7 @@
(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
(let ((length (length bytes))
(bytedecomp-ptr 0) optr tags bytedecomp-op offset
- lap tmp)
+ lap tmp last-constant)
(while (not (= bytedecomp-ptr length))
(or make-spliceable
(push bytedecomp-ptr lap))
@@ -1385,7 +1386,8 @@
(or (assq tmp byte-compile-variables)
(let ((new (list tmp)))
(push new byte-compile-variables)
- new)))))
+ new)))
+ last-constant tmp))
((eq bytedecomp-op 'byte-stack-set2)
(setq bytedecomp-op 'byte-stack-set))
((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80))
@@ -1394,7 +1396,34 @@
;; lapcode, we represent this by using a different opcode
;; (with the flag removed from the operand).
(setq bytedecomp-op 'byte-discardN-preserve-tos)
- (setq offset (- offset #x80))))
+ (setq offset (- offset #x80)))
+ ((eq bytedecomp-op 'byte-switch)
+ (cl-assert (hash-table-p last-constant) nil
+ "byte-switch used without preceeding hash table")
+ ;; We cannot use the original hash table referenced in the op,
+ ;; so we create a copy of it, and replace the addresses with
+ ;; TAGs.
+ (let ((orig-table last-constant))
+ (cl-loop for e across constvec
+ when (eq e last-constant)
+ do (setq last-constant (copy-hash-table e))
+ and return nil)
+ ;; Replace all addresses with TAGs.
+ (maphash #'(lambda (value tag)
+ (let (newtag)
+ (setq newtag (byte-compile-make-tag))
+ (push (cons tag newtag) tags)
+ (puthash value newtag last-constant)))
+ last-constant)
+ ;; Replace the hash table referenced in the lapcode with our
+ ;; modified one.
+ (cl-loop for el in-ref lap
+ when (and (listp el) ;; make sure we're at the correct op
+ (eq (nth 1 el) 'byte-constant)
+ (eq (nth 2 el) orig-table))
+ ;; jump tables are never resused, so we do this exactly
+ ;; once.
+ do (setf (nth 2 el) last-constant) and return nil))))
;; lap = ( [ (pc . (op . arg)) ]* )
(push (cons optr (cons bytedecomp-op (or offset 0)))
lap)
@@ -1728,7 +1757,10 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; unused-TAG: --> <deleted>
;;
((and (eq 'TAG (car lap0))
- (not (rassq lap0 lap)))
+ (not (rassq lap0 lap))
+ (cl-loop for table in byte-compile-jump-tables
+ when (member lap0 (hash-table-values table))
+ return nil finally return t))
(and (memq byte-optimize-log '(t byte))
(byte-compile-log " unused tag %d removed" (nth 1 lap0)))
(setq lap (delq lap0 lap)
@@ -1736,9 +1768,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;;
;; goto ... --> goto <delete until TAG or end>
;; return ... --> return <delete until TAG or end>
- ;;
+ ;; (unless a jump-table is being used, where deleting may affect
+ ;; other valid case bodies)
+ ;;
((and (memq (car lap0) '(byte-goto byte-return))
- (not (memq (car lap1) '(TAG nil))))
+ (not (memq (car lap1) '(TAG nil)))
+ ;; FIXME: Instead of deferring simply when jump-tables are
+ ;; being used, keep a list of tags used for switch tags and
+ ;; use them instead (see `byte-compile-inline-lapcode').
+ (not byte-compile-jump-tables))
(setq tmp rest)
(let ((i 0)
(opt-p (memq byte-optimize-log '(t lap)))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 09ea7206d6e..75e6b904aa6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -223,6 +223,11 @@ This includes variable references and calls to functions such as `car'."
:group 'bytecomp
:type 'boolean)
+(defcustom byte-compile-cond-use-jump-table t
+ "Compile `cond' clauses to a jump table implementation (using a hash-table)."
+ :group 'bytecomp
+ :type 'boolean)
+
(defvar byte-compile-dynamic nil
"If non-nil, compile function bodies so they load lazily.
They are hidden in comments in the compiled file,
@@ -412,6 +417,8 @@ specify different fields to sort on."
(const calls+callers) (const nil)))
(defvar byte-compile-debug nil)
+(defvar byte-compile-jump-tables nil
+ "List of all jump tables used during compilation of this form.")
(defvar byte-compile-constants nil
"List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
@@ -747,6 +754,10 @@ otherwise pop it")
;; `byte-compile-lapcode').
(defconst byte-discardN-preserve-tos byte-discardN)
+(byte-defop 183 -2 byte-switch
+ "to take a hash table and a value from the stack, and jump to the address
+the value maps to, if any.")
+
;; unused: 182-191
(byte-defop 192 1 byte-constant "for reference to a constant")
@@ -823,7 +834,7 @@ CONST2 may be evaluated multiple times."
op off ; Operation & offset
opcode ; numeric value of OP
(bytes '()) ; Put the output bytes here
- (patchlist nil)) ; List of gotos to patch
+ (patchlist nil)) ; List of gotos to patch
(dolist (lap-entry lap)
(setq op (car lap-entry)
off (cdr lap-entry))
@@ -905,6 +916,12 @@ CONST2 may be evaluated multiple times."
;; FIXME: Replace this by some workaround.
(if (> (car bytes-tail) 255) (error "Bytecode overflow")))
+ (dolist (hash-table byte-compile-jump-tables)
+ (maphash #'(lambda (value tag)
+ (setq pc (cadr tag))
+ (puthash value (+ (logand pc 255) (lsh (lsh pc -8) 8))
+ hash-table))
+ hash-table))
(apply 'unibyte-string (nreverse bytes))))
@@ -1954,7 +1971,8 @@ With argument ARG, insert value in current buffer after the form."
;; (edebug-all-defs nil)
;; (edebug-all-forms nil)
;; Simulate entry to byte-compile-top-level
- (byte-compile-constants nil)
+ (byte-compile-jump-tables nil)
+ (byte-compile-constants nil)
(byte-compile-variables nil)
(byte-compile-tag-number 0)
(byte-compile-depth 0)
@@ -2250,7 +2268,8 @@ list that represents a doc string reference.
byte-compile-variables nil
byte-compile-depth 0
byte-compile-maxdepth 0
- byte-compile-output nil))))
+ byte-compile-output nil
+ byte-compile-jump-tables nil))))
(defvar byte-compile-force-lexical-warnings nil)
@@ -2862,7 +2881,8 @@ for symbols generated by the byte compiler itself."
(byte-compile-maxdepth 0)
(byte-compile--lexical-environment lexenv)
(byte-compile-reserved-constants (or reserved-csts 0))
- (byte-compile-output nil))
+ (byte-compile-output nil)
+ (byte-compile-jump-tables nil))
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form byte-compile--for-effect)))
(while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
@@ -3114,15 +3134,57 @@ for symbols generated by the byte compiler itself."
;; happens to be true for byte-code generated by bytecomp.el without
;; lexical-binding, but it's not true in general, and it's not true for
;; code output by bytecomp.el with lexical-binding.
- (let ((endtag (byte-compile-make-tag)))
+ ;; We also restore the value of `byte-compile-depth' and remove TAG depths
+ ;; accordingly when inlining lapcode containing lap-code, exactly as
+ ;; documented in `byte-compile-cond-jump-table'.
+ (let ((endtag (byte-compile-make-tag))
+ last-jump-tag ;; last TAG we have jumped to
+ last-depth ;; last value of `byte-compile-depth'
+ last-constant ;; value of the last constant encountered
+ last-switch ;; whether the last op encountered was byte-switch
+ switch-tags ;; a list of tags that byte-switch could jump to
+ ;; a list of tags byte-switch will jump to, if the value doesn't
+ ;; match any entry in the hash table
+ switch-default-tags)
(dolist (op lap)
(cond
- ((eq (car op) 'TAG) (byte-compile-out-tag op))
- ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op)))
+ ((eq (car op) 'TAG)
+ (when (or (member op switch-tags) (member op switch-default-tags))
+ ;; This TAG is used in a jump table, this means the last goto
+ ;; was to a done/default TAG, and thus it's cddr should be set to nil.
+ (when last-jump-tag
+ (setcdr (cdr last-jump-tag) nil))
+ ;; Also, restore the value of `byte-compile-depth' to what it was
+ ;; before the last goto.
+ (setq byte-compile-depth last-depth
+ last-jump-tag nil))
+ (byte-compile-out-tag op))
+ ((memq (car op) byte-goto-ops)
+ (setq last-depth byte-compile-depth
+ last-jump-tag (cdr op))
+ (byte-compile-goto (car op) (cdr op))
+ (when last-switch
+ ;; The last op was byte-switch, this goto jumps to a "default" TAG
+ ;; (when no value in the jump table is satisfied).
+ (push (cdr op) switch-default-tags)
+ (setcdr (cdr (cdr op)) nil)
+ (setq byte-compile-depth last-depth
+ last-switch nil)))
((eq (car op) 'byte-return)
(byte-compile-discard (- byte-compile-depth end-depth) t)
(byte-compile-goto 'byte-goto endtag))
- (t (byte-compile-out (car op) (cdr op)))))
+ (t
+ (when (eq (car op) 'byte-switch)
+ ;; The last constant is a jump table.
+ (push last-constant byte-compile-jump-tables)
+ (setq last-switch t)
+ ;; Push all TAGs in the jump to switch-tags.
+ (maphash #'(lambda (_k tag)
+ (push tag switch-tags))
+ last-constant))
+ (setq last-constant (and (eq (car op) 'byte-constant) (cadr op)))
+ (setq last-depth byte-compile-depth)
+ (byte-compile-out (car op) (cdr op)))))
(byte-compile-out-tag endtag)))
(defun byte-compile-unfold-bcf (form)
@@ -3951,37 +4013,162 @@ that suppresses all warnings during execution of BODY."
(byte-compile-out-tag donetag))))
(setq byte-compile--for-effect nil))
+(defun byte-compile-cond-vars (obj1 obj2)
+ ;; We make sure that of OBJ1 and OBJ2, one of them is a symbol,
+ ;; and the other is a constant expression whose value can be
+ ;; compared with `eq' (with `macroexp-const-p').
+ (or
+ (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2))
+ (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1))))
+
+(defun byte-compile-cond-jump-table-info (clauses)
+ "If CLAUSES is a `cond' form where:
+The condition for each clause is of the form (TEST VAR VALUE).
+VAR is a variable.
+TEST and VAR are the same throughout all conditions.
+VALUE satisfies `macroexp-const-p'.
+
+Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))"
+ (let ((cases '())
+ (ok t)
+ prev-var prev-test)
+ (and (catch 'break
+ (dolist (clause (cdr clauses) ok)
+ (let* ((condition (car clause))
+ (test (car-safe condition))
+ (vars (when (consp condition)
+ (byte-compile-cond-vars (cadr condition) (cl-caddr condition))))
+ (obj1 (car-safe vars))
+ (obj2 (cdr-safe vars))
+ (body (cdr-safe clause)))
+ (unless prev-var
+ (setq prev-var obj1))
+ (unless prev-test
+ (setq prev-test test))
+ (if (and obj1 (memq test '(eq eql equal))
+ (consp condition)
+ (eq test prev-test)
+ (eq obj1 prev-var)
+ ;; discard duplicate clauses
+ (not (assq obj2 cases)))
+ (push (list (if (consp obj2) (eval obj2) obj2) body) cases)
+ (if (eq condition t)
+ (progn (push (list 'default body) cases)
+ (throw 'break t))
+ (setq ok nil)
+ (throw 'break nil))))))
+ (list (cons prev-test prev-var) (nreverse cases)))))
+
+(defun byte-compile-cond-jump-table (clauses)
+ (let* ((table-info (byte-compile-cond-jump-table-info clauses))
+ (test (caar table-info))
+ (var (cdar table-info))
+ (cases (cadr table-info))
+ jump-table test-obj body tag donetag default-tag default-case)
+ (when (and cases (not (= (length cases) 1)))
+ ;; TODO: Once :linear-search is implemented for `make-hash-table'
+ ;; set it to `t' for cond forms with a small number of cases.
+ (setq jump-table (make-hash-table :test test
+ :purecopy t
+ :size (if (assq 'default cases)
+ (1- (length cases))
+ (length cases)))
+ default-tag (byte-compile-make-tag)
+ donetag (byte-compile-make-tag))
+ ;; The structure of byte-switch code:
+ ;;
+ ;; varref var
+ ;; constant #s(hash-table purecopy t data (val1 (TAG1) val2 (TAG2)))
+ ;; switch
+ ;; goto DEFAUT-TAG
+ ;; TAG1
+ ;; <clause body>
+ ;; goto DONETAG
+ ;; TAG2
+ ;; <clause body>
+ ;; goto DONETAG
+ ;; DEFAULT-TAG
+ ;; <body for `t' clause, if any (else `constant nil')>
+ ;; DONETAG
+
+ (byte-compile-variable-ref var)
+ (byte-compile-push-constant jump-table)
+ (byte-compile-out 'byte-switch)
+
+ ;; When the opcode argument is `byte-goto', `byte-compile-goto' sets
+ ;; `byte-compile-depth' to `nil'. However, we need `byte-compile-depth'
+ ;; to be non-nil for generating tags for all cases. Since
+ ;; `byte-compile-depth' will increase by atmost 1 after compiling
+ ;; all of the clause (which is further enforced by cl-assert below)
+ ;; it should be safe to preserve it's value.
+ (let ((byte-compile-depth byte-compile-depth))
+ (byte-compile-goto 'byte-goto default-tag))
+
+ (when (assq 'default cases)
+ (setq default-case (cadr (assq 'default cases))
+ cases (butlast cases 1)))
+
+ (dolist (case cases)
+ (setq tag (byte-compile-make-tag)
+ test-obj (nth 0 case)
+ body (nth 1 case))
+ (byte-compile-out-tag tag)
+ (puthash test-obj tag jump-table)
+
+ (let ((byte-compile-depth byte-compile-depth)
+ (init-depth byte-compile-depth))
+ ;; Since `byte-compile-body' might increase `byte-compile-depth'
+ ;; by 1, not preserving it's value will cause it to potentially
+ ;; increase by one for every clause body compiled, causing
+ ;; depth/tag conflicts or violating asserts down the road.
+ ;; To make sure `byte-compile-body' itself doesn't violate this,
+ ;; we use `cl-assert'.
+ (byte-compile-body body byte-compile--for-effect)
+ (cl-assert (or (= byte-compile-depth init-depth)
+ (= byte-compile-depth (1+ init-depth))))
+ (byte-compile-goto 'byte-goto donetag)
+ (setcdr (cdr donetag) nil)))
+
+ (byte-compile-out-tag default-tag)
+ (if default-case
+ (byte-compile-body-do-effect default-case)
+ (byte-compile-constant nil))
+ (byte-compile-out-tag donetag)
+ (push jump-table byte-compile-jump-tables))))
+
(defun byte-compile-cond (clauses)
- (let ((donetag (byte-compile-make-tag))
- nexttag clause)
- (while (setq clauses (cdr clauses))
- (setq clause (car clauses))
- (cond ((or (eq (car clause) t)
- (and (eq (car-safe (car clause)) 'quote)
- (car-safe (cdr-safe (car clause)))))
- ;; Unconditional clause
- (setq clause (cons t clause)
- clauses nil))
- ((cdr clauses)
- (byte-compile-form (car clause))
- (if (null (cdr clause))
- ;; First clause is a singleton.
- (byte-compile-goto-if t byte-compile--for-effect donetag)
- (setq nexttag (byte-compile-make-tag))
- (byte-compile-goto 'byte-goto-if-nil nexttag)
- (byte-compile-maybe-guarded (car clause)
- (byte-compile-body (cdr clause) byte-compile--for-effect))
- (byte-compile-goto 'byte-goto donetag)
- (byte-compile-out-tag nexttag)))))
- ;; Last clause
- (let ((guard (car clause)))
- (and (cdr clause) (not (eq guard t))
- (progn (byte-compile-form guard)
- (byte-compile-goto-if nil byte-compile--for-effect donetag)
- (setq clause (cdr clause))))
- (byte-compile-maybe-guarded guard
- (byte-compile-body-do-effect clause)))
- (byte-compile-out-tag donetag)))
+ (or (and byte-compile-cond-use-jump-table
+ (byte-compile-cond-jump-table clauses))
+ (let ((donetag (byte-compile-make-tag))
+ nexttag clause)
+ (while (setq clauses (cdr clauses))
+ (setq clause (car clauses))
+ (cond ((or (eq (car clause) t)
+ (and (eq (car-safe (car clause)) 'quote)
+ (car-safe (cdr-safe (car clause)))))
+ ;; Unconditional clause
+ (setq clause (cons t clause)
+ clauses nil))
+ ((cdr clauses)
+ (byte-compile-form (car clause))
+ (if (null (cdr clause))
+ ;; First clause is a singleton.
+ (byte-compile-goto-if t byte-compile--for-effect donetag)
+ (setq nexttag (byte-compile-make-tag))
+ (byte-compile-goto 'byte-goto-if-nil nexttag)
+ (byte-compile-maybe-guarded (car clause)
+ (byte-compile-body (cdr clause) byte-compile--for-effect))
+ (byte-compile-goto 'byte-goto donetag)
+ (byte-compile-out-tag nexttag)))))
+ ;; Last clause
+ (let ((guard (car clause)))
+ (and (cdr clause) (not (eq guard t))
+ (progn (byte-compile-form guard)
+ (byte-compile-goto-if nil byte-compile--for-effect donetag)
+ (setq clause (cdr clause))))
+ (byte-compile-maybe-guarded guard
+ (byte-compile-body-do-effect clause)))
+ (byte-compile-out-tag donetag))))
(defun byte-compile-and (form)
(let ((failtag (byte-compile-make-tag))
@@ -4528,7 +4715,7 @@ binding slots have been popped."
(and byte-compile-depth
(not (= (cdr (cdr tag)) byte-compile-depth))
(error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
- (setq byte-compile-depth (cdr (cdr tag))))
+ (setq byte-compile-depth (cdr (cdr tag))))
(setcdr (cdr tag) byte-compile-depth)))
(defun byte-compile-goto (opcode tag)
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 97e45e070d0..66673b4d26c 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -221,9 +221,21 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
((memq op '(byte-constant byte-constant2))
;; it's a constant
(setq arg (car arg))
- ;; but if the value of the constant is compiled code, then
- ;; recursively disassemble it.
- (cond ((or (byte-code-function-p arg)
+ ;; if the succeeding op is byte-switch, display the jump table
+ ;; used
+ (cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch)
+ (insert (format "<jump-table-%s (" (hash-table-test arg)))
+ (let ((first-time t))
+ (maphash #'(lambda (value tag)
+ (if first-time
+ (setq first-time nil)
+ (insert " "))
+ (insert (format "%s %s" value (cadr tag))))
+ arg))
+ (insert ")>"))
+ ;; if the value of the constant is compiled code, then
+ ;; recursively disassemble it.
+ ((or (byte-code-function-p arg)
(and (consp arg) (functionp arg)
(assq 'byte-code arg))
(and (eq (car-safe arg) 'macro)
diff --git a/src/bytecode.c b/src/bytecode.c
index 0f7420c19ee..af94d03b17d 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -267,6 +267,8 @@ DEFINE (Bstack_set, 0262) \
DEFINE (Bstack_set2, 0263) \
DEFINE (BdiscardN, 0266) \
\
+DEFINE (Bswitch, 0267) \
+ \
DEFINE (Bconstant, 0300)
enum byte_code_op
@@ -1411,6 +1413,43 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
DISCARD (op);
NEXT;
+ CASE (Bswitch):
+ {
+ /*TODO: Perhaps introduce another byte-code for switch when the
+ number of cases is less, which uses a simple vector for linear
+ search as the jump table. */
+ Lisp_Object jmp_table = POP;
+ Lisp_Object v1 = POP;
+ ptrdiff_t i;
+ struct Lisp_Hash_Table *h = XHASH_TABLE(jmp_table);
+
+ /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
+ here. */
+ if (h->count <= 5)
+ { /* Do a linear search if there are not many cases
+ FIXME: 5 is arbitrarily chosen. */
+ Lisp_Object hash_code = h->test.cmpfn
+ ? make_number(h->test.hashfn (&h->test, v1)) : Qnil;
+
+ for (i = h->count; 0 <= --i;)
+ if (EQ (v1, HASH_KEY (h, i))
+ || (h->test.cmpfn
+ && EQ (hash_code, HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, v1, HASH_KEY (h, i))))
+ break;
+
+ }
+ else
+ i = hash_lookup(h, v1, NULL);
+
+ if (i >= 0)
+ {
+ op = XINT (HASH_VALUE (h, i));
+ goto op_branch;
+ }
+ }
+ NEXT;
+
CASE_DEFAULT
CASE (Bconstant):
if (BYTE_CODE_SAFE
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index bc47c82c1e1..acf9343914d 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -247,6 +247,20 @@
Each element will be executed by interpreter and with
bytecompiled code, and their results compared.")
+(defconst byte-opt-testsuite-cond-data
+ '(
+ (let ((a 3)) (cond ((eq a 1) 'one) ((eq a 2) 'two) ((eq a 3) 'three) (t t)))
+ (let ((a 'three)) (cond ((eq a 'one) 1) ((eq a 2) 'two) ((eq a 'three) 3)
+ (t t)))
+ (let ((a 2)) (cond ((eq a 'one) 1) ((eq a 1) 'one) ((eq a 2) 'two)
+ (t nil)))
+ (let ((a 2.0)) (cond ((eql a 2) 'incorrect) ((eql a 2.00) 'correct)))
+ (let ((a "foobar")) (cond ((equal "notfoobar" a) 'incorrect)
+ ((equal 1 a) 'incorrect)
+ ((equal a "foobar") 'correct)
+ (t 'incorrect))))
+ "List of expressions for testing byte-switch.")
+
(defun bytecomp-check-1 (pat)
"Return non-nil if PAT is the same whether directly evalled or compiled."
(let ((warning-minimum-log-level :emergency)
@@ -276,6 +290,11 @@ bytecompiled code, and their results compared.")
(dolist (pat byte-opt-testsuite-arith-data)
(should (bytecomp-check-1 pat))))
+(ert-deftest bytecomp-cond ()
+ "Test the Emacs byte compiler."
+ (dolist (pat byte-opt-testsuite-cond-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."
View Lorry Controller Status