Mercurial > hg > xemacs-beta
annotate tests/automated/byte-compiler-tests.el @ 5370:4c4b96b13f70
Address the easy test failures in tests/automated.
src/ChangeLog addition:
2011-03-11 Aidan Kehoe <kehoea@parhasard.net>
* bytecode.c (optimize_byte_code):
Only transform assignments to keywords to Bdiscard if
NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in
reject_constant_symbols().
tests/ChangeLog addition:
2011-03-11 Aidan Kehoe <kehoea@parhasard.net>
* automated/byte-compiler-tests.el:
(defconst :foo 1) now gives a warning when byte-compiled, check
for that.
(setq :foo 1) now errors with interpreted code, but succeeds with
byte-compiled code; check for the former, wrap a
Known-Bug-Expect-Failure around a check for the error in the
latter case, we can't yet remove this behaviour while we're using
packages compiled by 21.4.
* automated/lisp-tests.el (wrong-type-argument):
Integer zero is a valid argument to #'substring-no-properties, use
Assert not Check-Error for it. Check some other aspects of the
functionality of #'substring-no-properties in passing.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 11 Mar 2011 20:40:01 +0000 |
| parents | 0f66906b6e37 |
| children | ac37a5f7e5be |
| rev | line source |
|---|---|
| 428 | 1 ;; Copyright (C) 1998 Free Software Foundation, Inc. |
| 2 | |
| 3 ;; Author: Martin Buchholz <martin@xemacs.org> | |
| 4 ;; Maintainer: Martin Buchholz <martin@xemacs.org> | |
| 5 ;; Created: 1998 | |
| 6 ;; Keywords: tests | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 18 ;; General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 23 ;; 02111-1307, USA. | |
| 24 | |
| 25 ;;; Synched up with: Not in FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;;; Test byte-compiler functionality | |
| 30 ;;; See test-harness.el | |
| 31 | |
| 32 (condition-case err | |
| 33 (require 'test-harness) | |
| 34 (file-error | |
| 35 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 36 (push (file-name-directory load-file-name) load-path) | |
| 37 (require 'test-harness)))) | |
| 38 | |
| 39 (require 'bytecomp) | |
| 40 | |
| 41 ;; test constant symbol warnings | |
| 42 (defmacro check-byte-compiler-message (message-regexp &rest body) | |
| 43 `(Check-Message ,message-regexp (byte-compile '(lambda () ,@body)))) | |
| 44 | |
| 45 (check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1)) | |
| 46 (check-byte-compiler-message "Attempt to set constant symbol" (setq t 1)) | |
| 47 (check-byte-compiler-message "Attempt to set constant symbol" (setq nil 1)) | |
|
5370
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
48 (check-byte-compiler-message "Attempt to set constant symbol" (defconst :foo 1)) |
| 428 | 49 |
| 50 (check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1)) | |
| 51 (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo))) | |
| 52 (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((nil 'x)) (foo))) | |
| 53 (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((:foo 'x)) (foo))) | |
| 54 | |
| 55 | |
| 56 (check-byte-compiler-message "bound but not referenced" (let ((foo 'x)) 1)) | |
| 57 (Assert (not (boundp 'free-variable))) | |
| 58 (Assert (boundp 'byte-compile-warnings)) | |
| 59 (check-byte-compiler-message "assignment to free variable" (setq free-variable 1)) | |
| 60 (check-byte-compiler-message "reference to free variable" (car free-variable)) | |
| 61 (check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y)) | |
| 62 | |
| 63 (let ((fun '(lambda () (setq :foo 1)))) | |
| 64 (fset 'test-byte-compiler-fun fun)) | |
| 65 (Check-Error setting-constant (test-byte-compiler-fun)) | |
|
5370
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
66 (Check-Message "Attempt to set constant symbol" |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
67 (byte-compile 'test-byte-compiler-fun)) |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
68 |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
69 ;; Once NEED_TO_HANDLE_21_4_CODE is no longer defined in C, this will error |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
70 ;; correctly. It's disabled because the packages are compiled by 21.4. |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
71 (Known-Bug-Expect-Failure |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
72 (Check-Error setting-constant (test-byte-compiler-fun))) |
| 428 | 73 |
| 74 (eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil)) | |
| 75 (progn | |
| 76 (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo)) | |
| 77 (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo 1 setq-test-bar)) | |
| 78 (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo)) | |
| 79 (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo 1 setq-test-bar)) | |
| 80 ) | |
| 81 | |
| 82 ;;----------------------------------------------------- | |
| 83 ;; let, let* | |
| 84 ;;----------------------------------------------------- | |
| 85 | |
| 86 ;; Test interpreted and compiled lisp separately here | |
| 87 (check-byte-compiler-message "malformed let binding" (let ((x 1 2)) 3)) | |
| 88 (check-byte-compiler-message "malformed let binding" (let* ((x 1 2)) 3)) | |
| 89 | |
| 90 (Check-Error-Message | |
| 91 error "`let' bindings can have only one value-form" | |
| 92 (eval '(let ((x 1 2)) 3))) | |
| 93 | |
| 94 (Check-Error-Message | |
| 95 error "`let' bindings can have only one value-form" | |
| 96 (eval '(let* ((x 1 2)) 3))) | |
| 97 | |
| 434 | 98 (defmacro before-and-after-compile-equal (&rest form) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
99 `(Assert (equal (funcall (quote (lambda () ,@form))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
100 (funcall (byte-compile (quote (lambda () ,@form))))))) |
| 434 | 101 |
| 102 (defvar simplyamarker (point-min-marker)) | |
| 103 | |
| 104 ;; The byte optimizer must be careful with +/- with a single argument. | |
| 105 | |
| 106 (before-and-after-compile-equal (+)) | |
| 107 (before-and-after-compile-equal (+ 2 2)) | |
| 108 (before-and-after-compile-equal (+ 2 1)) | |
| 109 (before-and-after-compile-equal (+ 1 2)) | |
| 110 ;; (+ 1) is OK. but (+1) signals an error. | |
| 111 (before-and-after-compile-equal (+ 1)) | |
| 112 (before-and-after-compile-equal (+ 3)) | |
| 113 (before-and-after-compile-equal (+ simplyamarker 1)) | |
| 114 ;; The optimization (+ m) --> m is invalid when m is a marker. | |
| 115 ;; Currently the following test fails - controversial. | |
| 116 ;; (before-and-after-compile-equal (+ simplyamarker)) | |
| 117 ;; Same tests for minus. | |
| 118 (before-and-after-compile-equal (- 2 2)) | |
| 119 (before-and-after-compile-equal (- 2 1)) | |
| 120 (before-and-after-compile-equal (- 1 2)) | |
| 121 (before-and-after-compile-equal (- 1)) | |
| 122 (before-and-after-compile-equal (- 3)) | |
| 123 (before-and-after-compile-equal (- simplyamarker 1)) | |
| 124 (before-and-after-compile-equal (- simplyamarker)) | |
| 444 | 125 |
| 452 | 126 (before-and-after-compile-equal (let ((z 1)) (or (setq z 42)) z)) |
| 127 | |
| 444 | 128 ;; byte-after-unbind-ops |
| 129 | |
| 130 ;; byte-constant | |
| 131 ;; byte-dup | |
| 132 | |
| 133 ;; byte-symbolp | |
| 134 (before-and-after-compile-equal | |
| 135 (let ((x 's)) | |
| 136 (unwind-protect | |
| 137 (symbolp x) | |
| 138 (setq x 1)))) | |
| 139 | |
| 140 ;; byte-consp | |
| 141 (before-and-after-compile-equal | |
| 142 (let ((x '(a b))) | |
| 143 (unwind-protect | |
| 144 (consp x) | |
| 145 (setq x 1)))) | |
| 146 | |
| 147 ;; byte-stringp | |
| 148 (before-and-after-compile-equal | |
| 149 (let ((x "a")) | |
| 150 (unwind-protect | |
| 151 (stringp x) | |
| 152 (setq x 1)))) | |
| 153 | |
| 154 ;; byte-listp | |
| 155 (before-and-after-compile-equal | |
| 156 (let ((x '(a b c))) | |
| 157 (unwind-protect | |
| 158 (listp x) | |
| 159 (setq x 1)))) | |
| 160 | |
| 161 ;; byte-numberp | |
| 162 (before-and-after-compile-equal | |
| 163 (let ((x 1)) | |
| 164 (unwind-protect | |
| 165 (numberp x) | |
| 166 (setq x nil)))) | |
| 167 | |
| 168 ;; byte-integerp | |
| 169 (before-and-after-compile-equal | |
| 170 (let ((x 1)) | |
| 171 (unwind-protect | |
| 172 (integerp x) | |
| 173 (setq x nil)))) | |
| 174 | |
| 175 ;; byte-equal | |
| 176 (before-and-after-compile-equal | |
| 177 (let ((x 'a) | |
| 178 (y 'a)) | |
| 179 (unwind-protect | |
| 180 (eq x y) | |
| 181 (setq x 'c)))) | |
| 182 | |
| 183 ;; byte-not | |
| 184 (before-and-after-compile-equal | |
| 185 (let (x) | |
| 186 (unwind-protect | |
| 187 (not x) | |
| 188 (setq x t)))) | |
| 189 | |
| 190 ;; byte-cons | |
| 191 (before-and-after-compile-equal | |
| 192 (equal '(1 . 2) | |
| 193 (let ((x 1) | |
| 194 (y 2)) | |
| 195 (unwind-protect | |
| 196 (cons x y) | |
| 197 (setq x t))))) | |
| 198 | |
| 199 ;; byte-list1 | |
| 200 (before-and-after-compile-equal | |
| 201 (equal '(1) | |
| 202 (let ((x 1)) | |
| 203 (unwind-protect | |
| 204 (list x) | |
| 205 (setq x t))))) | |
| 206 | |
| 207 ;; byte-list2 | |
| 208 (before-and-after-compile-equal | |
| 209 (equal '(1 . 2) | |
| 210 (let ((x 1) | |
| 211 (y 2)) | |
| 212 (unwind-protect | |
| 213 (list x y) | |
| 214 (setq x t))))) | |
| 215 | |
| 216 ;; byte-interactive-p | |
| 217 | |
| 218 ;; byte-equal | |
| 219 (before-and-after-compile-equal | |
| 220 (let (x y) | |
| 221 (setq x '(1 . 2)) | |
| 222 (setq y '(1 . 2)) | |
| 223 (unwind-protect | |
| 224 (equal x y) | |
| 225 (setq y '(1 . 3))))) |