Mercurial > hg > xemacs-beta
comparison lisp/test-harness.el @ 5366:f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
2011-03-08 Aidan Kehoe <kehoea@parhasard.net>
* buff-menu.el (list-buffers-noselect):
* byte-optimize.el (byte-optimize-identity):
* byte-optimize.el (byte-optimize-if):
* byte-optimize.el (byte-optimize-nth):
* byte-optimize.el (byte-optimize-nthcdr):
* bytecomp.el (byte-compile-warn-wrong-args):
* bytecomp.el (byte-compile-two-args-19->20):
* bytecomp.el (byte-compile-list):
* bytecomp.el (byte-compile-beginning-of-line):
* bytecomp.el (byte-compile-set):
* bytecomp.el (byte-compile-set-default):
* bytecomp.el (byte-compile-values):
* bytecomp.el (byte-compile-values-list):
* bytecomp.el (byte-compile-integerp):
* bytecomp.el (byte-compile-multiple-value-list-internal):
* bytecomp.el (byte-compile-throw):
* cl-macs.el (cl-do-arglist):
* cl-macs.el (cl-parse-loop-clause):
* cl-macs.el (multiple-value-bind):
* cl-macs.el (multiple-value-setq):
* cl-macs.el (get-setf-method):
* cmdloop.el (command-error):
* cmdloop.el (y-or-n-p-minibuf):
* cmdloop.el (yes-or-no-p-minibuf):
* coding.el (unencodable-char-position):
* cus-edit.el (custom-face-prompt):
* cus-edit.el (custom-buffer-create-internal):
* cus-edit.el (widget-face-action):
* cus-edit.el (custom-group-value-create):
* descr-text.el (describe-char-unicode-data):
* dialog-gtk.el (popup-builtin-question-dialog):
* dragdrop.el (experimental-dragdrop-drop-log-function):
* dragdrop.el (experimental-dragdrop-drop-mime-default):
* easymenu.el (easy-menu-add):
* easymenu.el (easy-menu-remove):
* faces.el (read-face-name):
* faces.el (set-face-stipple):
* files.el (file-name-non-special):
* font.el (font-combine-fonts):
* font.el (font-set-face-font):
* font.el (font-parse-rgb-components):
* font.el (font-rgb-color-p):
* font.el (font-color-rgb-components):
* gnuserv.el (gnuserv-edit-files):
* help.el (key-or-menu-binding):
* help.el (function-documentation-1):
* help.el (function-documentation):
* info.el (info):
* isearch-mode.el (isearch-exit):
* isearch-mode.el (isearch-edit-string):
* isearch-mode.el (isearch-*-char):
* isearch-mode.el (isearch-complete1):
* ldap.el (ldap-encode-country-string):
* ldap.el (ldap-decode-string):
* minibuf.el (read-file-name-internal-1):
* minibuf.el (read-non-nil-coding-system):
* minibuf.el (get-user-response):
* mouse.el (drag-window-divider):
* mule/ccl.el:
* mule/ccl.el (ccl-compile-if):
* mule/ccl.el (ccl-compile-break):
* mule/ccl.el (ccl-compile-repeat):
* mule/ccl.el (ccl-compile-write-repeat):
* mule/ccl.el (ccl-compile-call):
* mule/ccl.el (ccl-compile-end):
* mule/ccl.el (ccl-compile-read-multibyte-character):
* mule/ccl.el (ccl-compile-write-multibyte-character):
* mule/ccl.el (ccl-compile-translate-character):
* mule/ccl.el (ccl-compile-mule-to-unicode):
* mule/ccl.el (ccl-compile-unicode-to-mule):
* mule/ccl.el (ccl-compile-lookup-integer):
* mule/ccl.el (ccl-compile-lookup-character):
* mule/ccl.el (ccl-compile-map-multiple):
* mule/ccl.el (ccl-compile-map-single):
* mule/devan-util.el (devanagari-compose-to-one-glyph):
* mule/devan-util.el (devanagari-composition-component):
* mule/mule-cmds.el (finish-set-language-environment):
* mule/viet-util.el:
* mule/viet-util.el (viet-encode-viscii-char):
* multicast.el (open-multicast-group):
* newcomment.el (comment-quote-nested):
* newcomment.el (comment-region):
* newcomment.el (comment-dwim):
* regexp-opt.el (regexp-opt-group):
* replace.el (map-query-replace-regexp):
* specifier.el (derive-device-type-from-tag-set):
* subr.el (skip-chars-quote):
* test-harness.el (test-harness-from-buffer):
* test-harness.el (batch-test-emacs):
* wid-edit.el (widget-choice-action):
* wid-edit.el (widget-symbol-prompt-internal):
* wid-edit.el (widget-color-action):
* window-xemacs.el (push-window-configuration):
* window-xemacs.el (pop-window-configuration):
* window.el (quit-window):
* x-compose.el (electric-diacritic):
It's better style, and cheaper (often one assembler instruction
vs. a C funcall in the byte code), to use `eql' instead of `='
when it's clear what numerical type a given result will be. Change
much of our code to do this, with the help of a byte-compiler
change (not comitted) that looked for calls to #'length (which
always returns an integer) in its args.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Tue, 08 Mar 2011 23:41:52 +0000 |
parents | ecdd1daab447 |
children | 4141aeddc55b |
comparison
equal
deleted
inserted
replaced
5365:dbae25a8949d | 5366:f00192e1cd49 |
---|---|
332 | 332 |
333 (defmacro Known-Bug-Expect-Error (expected-error &rest body) | 333 (defmacro Known-Bug-Expect-Error (expected-error &rest body) |
334 "Wrap a BODY that consists of tests that are known to trigger an error. | 334 "Wrap a BODY that consists of tests that are known to trigger an error. |
335 This causes messages to be printed on failure indicating that this is expected, | 335 This causes messages to be printed on failure indicating that this is expected, |
336 and on success indicating that this is unexpected." | 336 and on success indicating that this is unexpected." |
337 (let ((quoted-body (if (= 1 (length body)) | 337 (let ((quoted-body (if (eql 1 (length body)) |
338 `(quote ,(car body)) `(quote (progn ,@body))))) | 338 `(quote ,(car body)) `(quote (progn ,@body))))) |
339 `(let ((test-harness-bug-expected t) | 339 `(let ((test-harness-bug-expected t) |
340 (test-harness-failure-tag "KNOWN BUG") | 340 (test-harness-failure-tag "KNOWN BUG") |
341 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) | 341 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) |
342 (condition-case error-info | 342 (condition-case error-info |
399 expression is given. FAILING-CASE and DESCRIPTION are useful when Assert | 399 expression is given. FAILING-CASE and DESCRIPTION are useful when Assert |
400 is used in a loop." | 400 is used in a loop." |
401 (let ((test-assertion assertion) | 401 (let ((test-assertion assertion) |
402 (negated nil)) | 402 (negated nil)) |
403 (when (and (listp test-assertion) | 403 (when (and (listp test-assertion) |
404 (= 2 (length test-assertion)) | 404 (eql 2 (length test-assertion)) |
405 (memq (car test-assertion) '(not null))) | 405 (memq (car test-assertion) '(not null))) |
406 (setq test-assertion (cadr test-assertion)) | 406 (setq test-assertion (cadr test-assertion)) |
407 (setq negated t)) | 407 (setq negated t)) |
408 (when (and (listp test-assertion) | 408 (when (and (listp test-assertion) |
409 (= 3 (length test-assertion)) | 409 (eql 3 (length test-assertion)) |
410 (member (car test-assertion) | 410 (member (car test-assertion) |
411 '(eq eql equal equalp = string= < <= > >=))) | 411 '(eq eql equal equalp = string= < <= > >=))) |
412 (let* ((test (car test-assertion)) | 412 (let* ((test (car test-assertion)) |
413 (testval (second test-assertion)) | 413 (testval (second test-assertion)) |
414 (expected (third test-assertion)) | 414 (expected (third test-assertion)) |
447 (Print-Pass "%S" ,description) | 447 (Print-Pass "%S" ,description) |
448 (incf passes))) | 448 (incf passes))) |
449 (cl-assertion-failed nil)))) | 449 (cl-assertion-failed nil)))) |
450 | 450 |
451 (defmacro Check-Error (expected-error &rest body) | 451 (defmacro Check-Error (expected-error &rest body) |
452 (let ((quoted-body (if (= 1 (length body)) | 452 (let ((quoted-body (if (eql 1 (length body)) |
453 `(quote ,(car body)) `(quote (progn ,@body))))) | 453 `(quote ,(car body)) `(quote (progn ,@body))))) |
454 `(condition-case error-info | 454 `(condition-case error-info |
455 (progn | 455 (progn |
456 (setq trick-optimizer (progn ,@body)) | 456 (setq trick-optimizer (progn ,@body)) |
457 (Print-Failure "%S executed successfully, but expected error %S" | 457 (Print-Failure "%S executed successfully, but expected error %S" |
467 ,quoted-body ',expected-error error-info) | 467 ,quoted-body ',expected-error error-info) |
468 (incf wrong-error-failures))))) | 468 (incf wrong-error-failures))))) |
469 | 469 |
470 (defmacro Check-Error-Message (expected-error expected-error-regexp | 470 (defmacro Check-Error-Message (expected-error expected-error-regexp |
471 &rest body) | 471 &rest body) |
472 (let ((quoted-body (if (= 1 (length body)) | 472 (let ((quoted-body (if (eql 1 (length body)) |
473 `(quote ,(car body)) `(quote (progn ,@body))))) | 473 `(quote ,(car body)) `(quote (progn ,@body))))) |
474 `(condition-case error-info | 474 `(condition-case error-info |
475 (progn | 475 (progn |
476 (setq trick-optimizer (progn ,@body)) | 476 (setq trick-optimizer (progn ,@body)) |
477 (Print-Failure "%S executed successfully, but expected error %S" | 477 (Print-Failure "%S executed successfully, but expected error %S" |
496 ,quoted-body ',expected-error error-info) | 496 ,quoted-body ',expected-error error-info) |
497 (incf wrong-error-failures))))) | 497 (incf wrong-error-failures))))) |
498 | 498 |
499 ;; Do not use this with Silence-Message. | 499 ;; Do not use this with Silence-Message. |
500 (defmacro Check-Message (expected-message-regexp &rest body) | 500 (defmacro Check-Message (expected-message-regexp &rest body) |
501 (let ((quoted-body (if (= 1 (length body)) | 501 (let ((quoted-body (if (eql 1 (length body)) |
502 `(quote ,(car body)) | 502 `(quote ,(car body)) |
503 `(quote (progn ,@body))))) | 503 `(quote (progn ,@body))))) |
504 `(Skip-Test-Unless (fboundp 'defadvice) "can't defadvice" | 504 `(Skip-Test-Unless (fboundp 'defadvice) "can't defadvice" |
505 ,expected-message-regexp | 505 ,expected-message-regexp |
506 (let ((messages "")) | 506 (let ((messages "")) |
754 (when (> unexpected-test-suite-failures 0) | 754 (when (> unexpected-test-suite-failures 0) |
755 (message "\n***** There %s %d unexpected test suite %s in %s:" | 755 (message "\n***** There %s %d unexpected test suite %s in %s:" |
756 (if (= unexpected-test-suite-failures 1) "was" "were") | 756 (if (= unexpected-test-suite-failures 1) "was" "were") |
757 unexpected-test-suite-failures | 757 unexpected-test-suite-failures |
758 (if (= unexpected-test-suite-failures 1) "failure" "failures") | 758 (if (= unexpected-test-suite-failures 1) "failure" "failures") |
759 (if (= (length unexpected-test-suite-failure-files) 1) | 759 (if (eql (length unexpected-test-suite-failure-files) 1) |
760 "file" | 760 "file" |
761 "files")) | 761 "files")) |
762 (while unexpected-test-suite-failure-files | 762 (while unexpected-test-suite-failure-files |
763 (let ((line (pop unexpected-test-suite-failure-files))) | 763 (let ((line (pop unexpected-test-suite-failure-files))) |
764 (while (and (< (length line) 61) | 764 (while (and (< (length line) 61) |