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)