Mercurial > hg > xemacs-beta
annotate tests/automated/byte-compiler-tests.el @ 5940:c608d4b0b75e cygwin64 tip
rescue lost branch from 64bit.backup
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Thu, 16 Dec 2021 18:48:58 +0000 |
| parents | ac37a5f7e5be |
| children |
| 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
13 ;; option) any later version. |
| 428 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
18 ;; for more details. |
| 428 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 22 |
| 23 ;;; Synched up with: Not in FSF. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;;; Test byte-compiler functionality | |
| 28 ;;; See test-harness.el | |
| 29 | |
| 30 (condition-case err | |
| 31 (require 'test-harness) | |
| 32 (file-error | |
| 33 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 34 (push (file-name-directory load-file-name) load-path) | |
| 35 (require 'test-harness)))) | |
| 36 | |
| 37 (require 'bytecomp) | |
| 38 | |
| 39 ;; test constant symbol warnings | |
| 40 (defmacro check-byte-compiler-message (message-regexp &rest body) | |
| 41 `(Check-Message ,message-regexp (byte-compile '(lambda () ,@body)))) | |
| 42 | |
| 43 (check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1)) | |
| 44 (check-byte-compiler-message "Attempt to set constant symbol" (setq t 1)) | |
| 45 (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
|
46 (check-byte-compiler-message "Attempt to set constant symbol" (defconst :foo 1)) |
| 428 | 47 |
| 48 (check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1)) | |
| 49 (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo))) | |
| 50 (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((nil 'x)) (foo))) | |
| 51 (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((:foo 'x)) (foo))) | |
| 52 | |
| 53 | |
| 54 (check-byte-compiler-message "bound but not referenced" (let ((foo 'x)) 1)) | |
| 55 (Assert (not (boundp 'free-variable))) | |
| 56 (Assert (boundp 'byte-compile-warnings)) | |
| 57 (check-byte-compiler-message "assignment to free variable" (setq free-variable 1)) | |
| 58 (check-byte-compiler-message "reference to free variable" (car free-variable)) | |
| 59 (check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y)) | |
| 60 | |
| 61 (let ((fun '(lambda () (setq :foo 1)))) | |
| 62 (fset 'test-byte-compiler-fun fun)) | |
| 63 (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
|
64 (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
|
65 (byte-compile 'test-byte-compiler-fun)) |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
66 |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
67 ;; 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
|
68 ;; 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
|
69 (Known-Bug-Expect-Failure |
|
4c4b96b13f70
Address the easy test failures in tests/automated.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5136
diff
changeset
|
70 (Check-Error setting-constant (test-byte-compiler-fun))) |
| 428 | 71 |
| 72 (eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil)) | |
| 73 (progn | |
| 74 (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo)) | |
| 75 (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo 1 setq-test-bar)) | |
| 76 (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo)) | |
| 77 (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo 1 setq-test-bar)) | |
| 78 ) | |
| 79 | |
| 80 ;;----------------------------------------------------- | |
| 81 ;; let, let* | |
| 82 ;;----------------------------------------------------- | |
| 83 | |
| 84 ;; Test interpreted and compiled lisp separately here | |
| 85 (check-byte-compiler-message "malformed let binding" (let ((x 1 2)) 3)) | |
| 86 (check-byte-compiler-message "malformed let binding" (let* ((x 1 2)) 3)) | |
| 87 | |
| 88 (Check-Error-Message | |
| 89 error "`let' bindings can have only one value-form" | |
| 90 (eval '(let ((x 1 2)) 3))) | |
| 91 | |
| 92 (Check-Error-Message | |
| 93 error "`let' bindings can have only one value-form" | |
| 94 (eval '(let* ((x 1 2)) 3))) | |
| 95 | |
| 434 | 96 (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
|
97 `(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
|
98 (funcall (byte-compile (quote (lambda () ,@form))))))) |
| 434 | 99 |
| 100 (defvar simplyamarker (point-min-marker)) | |
| 101 | |
| 102 ;; The byte optimizer must be careful with +/- with a single argument. | |
| 103 | |
| 104 (before-and-after-compile-equal (+)) | |
| 105 (before-and-after-compile-equal (+ 2 2)) | |
| 106 (before-and-after-compile-equal (+ 2 1)) | |
| 107 (before-and-after-compile-equal (+ 1 2)) | |
| 108 ;; (+ 1) is OK. but (+1) signals an error. | |
| 109 (before-and-after-compile-equal (+ 1)) | |
| 110 (before-and-after-compile-equal (+ 3)) | |
| 111 (before-and-after-compile-equal (+ simplyamarker 1)) | |
| 112 ;; The optimization (+ m) --> m is invalid when m is a marker. | |
| 113 ;; Currently the following test fails - controversial. | |
| 114 ;; (before-and-after-compile-equal (+ simplyamarker)) | |
| 115 ;; Same tests for minus. | |
| 116 (before-and-after-compile-equal (- 2 2)) | |
| 117 (before-and-after-compile-equal (- 2 1)) | |
| 118 (before-and-after-compile-equal (- 1 2)) | |
| 119 (before-and-after-compile-equal (- 1)) | |
| 120 (before-and-after-compile-equal (- 3)) | |
| 121 (before-and-after-compile-equal (- simplyamarker 1)) | |
| 122 (before-and-after-compile-equal (- simplyamarker)) | |
| 444 | 123 |
| 452 | 124 (before-and-after-compile-equal (let ((z 1)) (or (setq z 42)) z)) |
| 125 | |
| 444 | 126 ;; byte-after-unbind-ops |
| 127 | |
| 128 ;; byte-constant | |
| 129 ;; byte-dup | |
| 130 | |
| 131 ;; byte-symbolp | |
| 132 (before-and-after-compile-equal | |
| 133 (let ((x 's)) | |
| 134 (unwind-protect | |
| 135 (symbolp x) | |
| 136 (setq x 1)))) | |
| 137 | |
| 138 ;; byte-consp | |
| 139 (before-and-after-compile-equal | |
| 140 (let ((x '(a b))) | |
| 141 (unwind-protect | |
| 142 (consp x) | |
| 143 (setq x 1)))) | |
| 144 | |
| 145 ;; byte-stringp | |
| 146 (before-and-after-compile-equal | |
| 147 (let ((x "a")) | |
| 148 (unwind-protect | |
| 149 (stringp x) | |
| 150 (setq x 1)))) | |
| 151 | |
| 152 ;; byte-listp | |
| 153 (before-and-after-compile-equal | |
| 154 (let ((x '(a b c))) | |
| 155 (unwind-protect | |
| 156 (listp x) | |
| 157 (setq x 1)))) | |
| 158 | |
| 159 ;; byte-numberp | |
| 160 (before-and-after-compile-equal | |
| 161 (let ((x 1)) | |
| 162 (unwind-protect | |
| 163 (numberp x) | |
| 164 (setq x nil)))) | |
| 165 | |
| 166 ;; byte-integerp | |
| 167 (before-and-after-compile-equal | |
| 168 (let ((x 1)) | |
| 169 (unwind-protect | |
| 170 (integerp x) | |
| 171 (setq x nil)))) | |
| 172 | |
| 173 ;; byte-equal | |
| 174 (before-and-after-compile-equal | |
| 175 (let ((x 'a) | |
| 176 (y 'a)) | |
| 177 (unwind-protect | |
| 178 (eq x y) | |
| 179 (setq x 'c)))) | |
| 180 | |
| 181 ;; byte-not | |
| 182 (before-and-after-compile-equal | |
| 183 (let (x) | |
| 184 (unwind-protect | |
| 185 (not x) | |
| 186 (setq x t)))) | |
| 187 | |
| 188 ;; byte-cons | |
| 189 (before-and-after-compile-equal | |
| 190 (equal '(1 . 2) | |
| 191 (let ((x 1) | |
| 192 (y 2)) | |
| 193 (unwind-protect | |
| 194 (cons x y) | |
| 195 (setq x t))))) | |
| 196 | |
| 197 ;; byte-list1 | |
| 198 (before-and-after-compile-equal | |
| 199 (equal '(1) | |
| 200 (let ((x 1)) | |
| 201 (unwind-protect | |
| 202 (list x) | |
| 203 (setq x t))))) | |
| 204 | |
| 205 ;; byte-list2 | |
| 206 (before-and-after-compile-equal | |
| 207 (equal '(1 . 2) | |
| 208 (let ((x 1) | |
| 209 (y 2)) | |
| 210 (unwind-protect | |
| 211 (list x y) | |
| 212 (setq x t))))) | |
| 213 | |
| 214 ;; byte-interactive-p | |
| 215 | |
| 216 ;; byte-equal | |
| 217 (before-and-after-compile-equal | |
| 218 (let (x y) | |
| 219 (setq x '(1 . 2)) | |
| 220 (setq y '(1 . 2)) | |
| 221 (unwind-protect | |
| 222 (equal x y) | |
| 223 (setq y '(1 . 3))))) |