Mercurial > hg > xemacs-beta

comparison lisp/test-harness.el @ 5136:0f66906b6e37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * test-harness.el (test-harness-from-buffer): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen. tests/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * automated/base64-tests.el (bt-base64-encode-string): * automated/base64-tests.el (bt-base64-decode-string): * automated/base64-tests.el (for): * automated/byte-compiler-tests.el: * automated/byte-compiler-tests.el (before-and-after-compile-equal): * automated/case-tests.el (downcase-string): * automated/case-tests.el (uni-mappings): * automated/ccl-tests.el (ccl-test-normal-expr): * automated/ccl-tests.el (ccl-test-map-instructions): * automated/ccl-tests.el (ccl-test-suites): * automated/database-tests.el (delete-database-files): * automated/extent-tests.el (let): * automated/extent-tests.el (insert): * automated/extent-tests.el (props): * automated/file-tests.el: * automated/file-tests.el (for): * automated/hash-table-tests.el (test): * automated/hash-table-tests.el (for): * automated/hash-table-tests.el (ht): * automated/hash-table-tests.el (iterations): * automated/hash-table-tests.el (h1): * automated/hash-table-tests.el (equal): * automated/hash-table-tests.el (=): * automated/lisp-tests.el: * automated/lisp-tests.el (eq): * automated/lisp-tests.el (test-setq): * automated/lisp-tests.el (my-vector): * automated/lisp-tests.el (x): * automated/lisp-tests.el (equal): * automated/lisp-tests.el (y): * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (=): * automated/lisp-tests.el (six): * automated/lisp-tests.el (three): * automated/lisp-tests.el (one): * automated/lisp-tests.el (two): * automated/lisp-tests.el (five): * automated/lisp-tests.el (test1): * automated/lisp-tests.el (division-test): * automated/lisp-tests.el (for): * automated/lisp-tests.el (check-function-argcounts): * automated/lisp-tests.el (z): * automated/lisp-tests.el (eql): * automated/lisp-tests.el (test-harness-risk-infloops): * automated/lisp-tests.el (erase-buffer): * automated/lisp-tests.el (sym): * automated/lisp-tests.el (new-char): * automated/lisp-tests.el (new-load-file-name): * automated/lisp-tests.el (cl-floor): * automated/lisp-tests.el (foo): * automated/md5-tests.el (lambda): * automated/md5-tests.el (large-string): * automated/md5-tests.el (mapcar): * automated/md5-tests.el (insert): * automated/mule-tests.el: * automated/mule-tests.el (test-chars): * automated/mule-tests.el (existing-file-name): * automated/mule-tests.el (featurep): * automated/query-coding-tests.el (featurep): * automated/regexp-tests.el: * automated/regexp-tests.el (insert): * automated/regexp-tests.el (Assert): * automated/regexp-tests.el (=): * automated/regexp-tests.el (featurep): * automated/regexp-tests.el (text): * automated/regexp-tests.el (text1): * automated/regexp-tests.el ("aáa"): * automated/regexp-tests.el (eql): * automated/search-tests.el (insert): * automated/search-tests.el (featurep): * automated/search-tests.el (let): * automated/search-tests.el (boundp): * automated/symbol-tests.el: * automated/symbol-tests.el (name): * automated/symbol-tests.el (check-weak-list-unique): * automated/symbol-tests.el (string): * automated/symbol-tests.el (list): * automated/symbol-tests.el (foo): * automated/symbol-tests.el (eq): * automated/symbol-tests.el (fresh-keyword-name): * automated/symbol-tests.el (print-gensym): * automated/symbol-tests.el (mysym): * automated/syntax-tests.el (test-forward-word): * automated/syntax-tests.el (test-backward-word): * automated/syntax-tests.el (test-syntax-table): * automated/syntax-tests.el (with-syntax-table): * automated/syntax-tests.el (Skip-Test-Unless): * automated/syntax-tests.el (with): * automated/tag-tests.el (testfile): * automated/weak-tests.el (w): * automated/weak-tests.el (p): * automated/weak-tests.el (a): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen.
author Ben Wing <ben@xemacs.org>
date Fri, 12 Mar 2010 18:27:51 -0600
parents b24cf478a45e
children ecdd1daab447
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5136:0f66906b6e37
396 "Test passes if ASSERTION is true. 396 "Test passes if ASSERTION is true.
397 Optional FAILING-CASE describes the particular failure. Optional 397 Optional FAILING-CASE describes the particular failure. Optional
398 DESCRIPTION describes the assertion; by default, the unevalated assertion 398 DESCRIPTION describes the assertion; by default, the unevalated assertion
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)
402 (negated nil))
403 (when (and (listp test-assertion)
404 (= 2 (length test-assertion))
405 (memq (car test-assertion) '(not null)))
406 (setq test-assertion (cadr test-assertion))
407 (setq negated t))
408 (when (and (listp test-assertion)
409 (= 3 (length test-assertion))
410 (member (car test-assertion)
411 '(eq eql equal equalp = string= < <= > >=)))
412 (let* ((test (car test-assertion))
413 (testval (second test-assertion))
414 (expected (third test-assertion))
415 (failmsg `(format ,(if negated
416 "%S shouldn't be `%s' to %S but is"
417 "%S should be `%s' to %S but isn't")
418 ,testval ',test ,expected)))
419 (setq failing-case (if failing-case
420 `(concat
421 (format "%S, " ,failing-case)
422 ,failmsg)
423 failmsg)))))
401 (let ((description 424 (let ((description
402 (or description `(quote ,assertion)))) 425 (or description `(quote ,assertion))))
403 `(condition-case nil 426 `(condition-case nil
404 (call-with-condition-handler 427 (call-with-condition-handler
405 #'(lambda (error-info) 428 #'(lambda (error-info)
422 #'(lambda () 445 #'(lambda ()
423 (assert ,assertion) 446 (assert ,assertion)
424 (Print-Pass "%S" ,description) 447 (Print-Pass "%S" ,description)
425 (incf passes))) 448 (incf passes)))
426 (cl-assertion-failed nil)))) 449 (cl-assertion-failed nil))))
427
428 ;;;;; BEGIN DEFINITION OF SPECIFIC KINDS OF ASSERT MACROS
429
430 (defmacro Assert-test (test testval expected &optional failing-case
431 description)
432 "Test passes if TESTVAL compares correctly to EXPECTED using TEST.
433 TEST should be a two-argument predicate (i.e. a function of two arguments
434 that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=',
435 '>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the
436 particular failure; any value given here will be concatenated with a phrase
437 describing the expected and actual values of the comparison. Optional
438 DESCRIPTION describes the assertion; by default, the unevalated comparison
439 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
440 is used in a loop."
441 (let* ((assertion `(,test ,testval ,expected))
442 (failmsg `(format "%S should be `%s' to %S but isn't"
443 ,testval ',test ,expected))
444 (failmsg2 (if failing-case `(concat
445 (format "%S, " ,failing-case)
446 ,failmsg)
447 failmsg)))
448 `(Assert ,assertion ,failmsg2 ,description)))
449
450 (defmacro Assert-test-not (test testval expected &optional failing-case
451 description)
452 "Test passes if TESTVAL does not compare correctly to EXPECTED using TEST.
453 TEST should be a two-argument predicate (i.e. a function of two arguments
454 that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=',
455 '>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the
456 particular failure; any value given here will be concatenated with a phrase
457 describing the expected and actual values of the comparison. Optional
458 DESCRIPTION describes the assertion; by default, the unevalated comparison
459 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
460 is used in a loop."
461 (let* ((assertion `(not (,test ,testval ,expected)))
462 (failmsg `(format "%S shouldn't be `%s' to %S but is"
463 ,testval ',test ,expected))
464 (failmsg2 (if failing-case `(concat
465 (format "%S, " ,failing-case)
466 ,failmsg)
467 failmsg)))
468 `(Assert ,assertion ,failmsg2 ,description)))
469
470 ;; Specific versions of `Assert-test'. These are just convenience
471 ;; functions, functioning identically to `Assert-test', and duplicating
472 ;; the doc string for each would be too annoying.
473 (defmacro Assert-eq (testval expected &optional failing-case
474 description)
475 `(Assert-test eq ,testval ,expected ,failing-case ,description))
476 (defmacro Assert-eql (testval expected &optional failing-case
477 description)
478 `(Assert-test eql ,testval ,expected ,failing-case ,description))
479 (defmacro Assert-equal (testval expected &optional failing-case
480 description)
481 `(Assert-test equal ,testval ,expected ,failing-case ,description))
482 (defmacro Assert-equalp (testval expected &optional failing-case
483 description)
484 `(Assert-test equalp ,testval ,expected ,failing-case ,description))
485 (defmacro Assert-string= (testval expected &optional failing-case
486 description)
487 `(Assert-test string= ,testval ,expected ,failing-case ,description))
488 (defmacro Assert= (testval expected &optional failing-case
489 description)
490 `(Assert-test = ,testval ,expected ,failing-case ,description))
491 (defmacro Assert<= (testval expected &optional failing-case
492 description)
493 `(Assert-test <= ,testval ,expected ,failing-case ,description))
494
495 ;; Specific versions of `Assert-test-not'. These are just convenience
496 ;; functions, functioning identically to `Assert-test-not', and
497 ;; duplicating the doc string for each would be too annoying.
498 (defmacro Assert-not-eq (testval expected &optional failing-case
499 description)
500 `(Assert-test-not eq ,testval ,expected ,failing-case ,description))
501 (defmacro Assert-not-eql (testval expected &optional failing-case
502 description)
503 `(Assert-test-not eql ,testval ,expected ,failing-case ,description))
504 (defmacro Assert-not-equal (testval expected &optional failing-case
505 description)
506 `(Assert-test-not equal ,testval ,expected ,failing-case ,description))
507 (defmacro Assert-not-equalp (testval expected &optional failing-case
508 description)
509 `(Assert-test-not equalp ,testval ,expected ,failing-case ,description))
510 (defmacro Assert-not-string= (testval expected &optional failing-case
511 description)
512 `(Assert-test-not string= ,testval ,expected ,failing-case ,description))
513 (defmacro Assert-not= (testval expected &optional failing-case
514 description)
515 `(Assert-test-not = ,testval ,expected ,failing-case ,description))
516 450
517 (defmacro Check-Error (expected-error &rest body) 451 (defmacro Check-Error (expected-error &rest body)
518 (let ((quoted-body (if (= 1 (length body)) 452 (let ((quoted-body (if (= 1 (length body))
519 `(quote ,(car body)) `(quote (progn ,@body))))) 453 `(quote ,(car body)) `(quote (progn ,@body)))))
520 `(condition-case error-info 454 `(condition-case error-info