Mercurial > hg > xemacs-beta
annotate tests/automated/byte-compiler-tests.el @ 5202:1c615eb1e4b2
disable specifier memory usage for the moment
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-04-12 Ben Wing <ben@xemacs.org>
* specifier.c (specifier_memory_usage):
Disable specifier memory-usage stats for now. Sometimes they can
end up with circularities in them and I'm not sure exactly whats
going on to produce them.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 12 Apr 2010 01:41:38 -0500 |
| parents | 0f66906b6e37 |
| children | 4c4b96b13f70 308d34e9f07d |
| 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)) | |
| 48 (check-byte-compiler-message "^$" (defconst :foo 1)) | |
| 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 (check-byte-compiler-message "^$" (setq :foo 1)) | |
| 64 (let ((fun '(lambda () (setq :foo 1)))) | |
| 65 (fset 'test-byte-compiler-fun fun)) | |
| 66 (Check-Error setting-constant (test-byte-compiler-fun)) | |
| 67 (byte-compile 'test-byte-compiler-fun) | |
| 68 (Check-Error setting-constant (test-byte-compiler-fun)) | |
| 69 | |
| 70 (eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil)) | |
| 71 (progn | |
| 72 (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo)) | |
| 73 (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo 1 setq-test-bar)) | |
| 74 (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo)) | |
| 75 (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo 1 setq-test-bar)) | |
| 76 ) | |
| 77 | |
| 78 ;;----------------------------------------------------- | |
| 79 ;; let, let* | |
| 80 ;;----------------------------------------------------- | |
| 81 | |
| 82 ;; Test interpreted and compiled lisp separately here | |
| 83 (check-byte-compiler-message "malformed let binding" (let ((x 1 2)) 3)) | |
| 84 (check-byte-compiler-message "malformed let binding" (let* ((x 1 2)) 3)) | |
| 85 | |
| 86 (Check-Error-Message | |
| 87 error "`let' bindings can have only one value-form" | |
| 88 (eval '(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 | |
| 434 | 94 (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
|
95 `(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
|
96 (funcall (byte-compile (quote (lambda () ,@form))))))) |
| 434 | 97 |
| 98 (defvar simplyamarker (point-min-marker)) | |
| 99 | |
| 100 ;; The byte optimizer must be careful with +/- with a single argument. | |
| 101 | |
| 102 (before-and-after-compile-equal (+)) | |
| 103 (before-and-after-compile-equal (+ 2 2)) | |
| 104 (before-and-after-compile-equal (+ 2 1)) | |
| 105 (before-and-after-compile-equal (+ 1 2)) | |
| 106 ;; (+ 1) is OK. but (+1) signals an error. | |
| 107 (before-and-after-compile-equal (+ 1)) | |
| 108 (before-and-after-compile-equal (+ 3)) | |
| 109 (before-and-after-compile-equal (+ simplyamarker 1)) | |
| 110 ;; The optimization (+ m) --> m is invalid when m is a marker. | |
| 111 ;; Currently the following test fails - controversial. | |
| 112 ;; (before-and-after-compile-equal (+ simplyamarker)) | |
| 113 ;; Same tests for minus. | |
| 114 (before-and-after-compile-equal (- 2 2)) | |
| 115 (before-and-after-compile-equal (- 2 1)) | |
| 116 (before-and-after-compile-equal (- 1 2)) | |
| 117 (before-and-after-compile-equal (- 1)) | |
| 118 (before-and-after-compile-equal (- 3)) | |
| 119 (before-and-after-compile-equal (- simplyamarker 1)) | |
| 120 (before-and-after-compile-equal (- simplyamarker)) | |
| 444 | 121 |
| 452 | 122 (before-and-after-compile-equal (let ((z 1)) (or (setq z 42)) z)) |
| 123 | |
| 444 | 124 ;; byte-after-unbind-ops |
| 125 | |
| 126 ;; byte-constant | |
| 127 ;; byte-dup | |
| 128 | |
| 129 ;; byte-symbolp | |
| 130 (before-and-after-compile-equal | |
| 131 (let ((x 's)) | |
| 132 (unwind-protect | |
| 133 (symbolp x) | |
| 134 (setq x 1)))) | |
| 135 | |
| 136 ;; byte-consp | |
| 137 (before-and-after-compile-equal | |
| 138 (let ((x '(a b))) | |
| 139 (unwind-protect | |
| 140 (consp x) | |
| 141 (setq x 1)))) | |
| 142 | |
| 143 ;; byte-stringp | |
| 144 (before-and-after-compile-equal | |
| 145 (let ((x "a")) | |
| 146 (unwind-protect | |
| 147 (stringp x) | |
| 148 (setq x 1)))) | |
| 149 | |
| 150 ;; byte-listp | |
| 151 (before-and-after-compile-equal | |
| 152 (let ((x '(a b c))) | |
| 153 (unwind-protect | |
| 154 (listp x) | |
| 155 (setq x 1)))) | |
| 156 | |
| 157 ;; byte-numberp | |
| 158 (before-and-after-compile-equal | |
| 159 (let ((x 1)) | |
| 160 (unwind-protect | |
| 161 (numberp x) | |
| 162 (setq x nil)))) | |
| 163 | |
| 164 ;; byte-integerp | |
| 165 (before-and-after-compile-equal | |
| 166 (let ((x 1)) | |
| 167 (unwind-protect | |
| 168 (integerp x) | |
| 169 (setq x nil)))) | |
| 170 | |
| 171 ;; byte-equal | |
| 172 (before-and-after-compile-equal | |
| 173 (let ((x 'a) | |
| 174 (y 'a)) | |
| 175 (unwind-protect | |
| 176 (eq x y) | |
| 177 (setq x 'c)))) | |
| 178 | |
| 179 ;; byte-not | |
| 180 (before-and-after-compile-equal | |
| 181 (let (x) | |
| 182 (unwind-protect | |
| 183 (not x) | |
| 184 (setq x t)))) | |
| 185 | |
| 186 ;; byte-cons | |
| 187 (before-and-after-compile-equal | |
| 188 (equal '(1 . 2) | |
| 189 (let ((x 1) | |
| 190 (y 2)) | |
| 191 (unwind-protect | |
| 192 (cons x y) | |
| 193 (setq x t))))) | |
| 194 | |
| 195 ;; byte-list1 | |
| 196 (before-and-after-compile-equal | |
| 197 (equal '(1) | |
| 198 (let ((x 1)) | |
| 199 (unwind-protect | |
| 200 (list x) | |
| 201 (setq x t))))) | |
| 202 | |
| 203 ;; byte-list2 | |
| 204 (before-and-after-compile-equal | |
| 205 (equal '(1 . 2) | |
| 206 (let ((x 1) | |
| 207 (y 2)) | |
| 208 (unwind-protect | |
| 209 (list x y) | |
| 210 (setq x t))))) | |
| 211 | |
| 212 ;; byte-interactive-p | |
| 213 | |
| 214 ;; byte-equal | |
| 215 (before-and-after-compile-equal | |
| 216 (let (x y) | |
| 217 (setq x '(1 . 2)) | |
| 218 (setq y '(1 . 2)) | |
| 219 (unwind-protect | |
| 220 (equal x y) | |
| 221 (setq y '(1 . 3))))) |