APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1293671653 0 # Node ID f87bb35a6b94954e154e89f9138c6dd6487377cc # Parent df125a42c50cdcfa85a5cceae8256cbeb842cac4 Test sanity-checking of :start, :end keyword arguments when appropriate. 2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el (wrong-type-argument): Add a missing parenthesis here. Make sure #'count #'position #'find #'delete* #'remove* #'reduce #'delete-duplicates #'remove-duplicates #'replace #'mismatch #'search sanity check their :start and :end keyword arguments. diff -r df125a42c50c -r f87bb35a6b94 tests/ChangeLog --- a/tests/ChangeLog Thu Dec 30 01:04:38 2010 +0000 +++ b/tests/ChangeLog Thu Dec 30 01:14:13 2010 +0000 ＠＠ -1,3 +1,11 ＠＠ +2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el (wrong-type-argument): Add a missing + parenthesis here. + Make sure #'count #'position #'find #'delete* #'remove* #'reduce + #'delete-duplicates #'remove-duplicates #'replace #'mismatch + #'search sanity check their :start and :end keyword arguments. + 2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: diff -r df125a42c50c -r f87bb35a6b94 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Thu Dec 30 01:04:38 2010 +0000 +++ b/tests/automated/lisp-tests.el Thu Dec 30 01:14:13 2010 +0000 ＠＠ -2549,7 +2549,7 ＠＠ (Check-Error wrong-type-argument (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum))) (Check-Error wrong-type-argument - (fill #*10101010 1 :start (float most-positive-fixnum)) + (fill #*10101010 1 :start (float most-positive-fixnum))) (Check-Error wrong-type-argument (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum))) (Check-Error wrong-type-argument ＠＠ -2669,4 +2669,125 ＠＠ (replace '(1 2 3 4 5) [5 4 3 2 1] :end2 (1+ most-positive-fixnum)))) +(symbol-macrolet + ((list-length 2048) (vector-length 512) (string-length (* 8192 2))) + (let ((list + ;; CIRCULAR_LIST_SUSPICION_LENGTH is 1024, it's helpful if this list + ;; is longer than that. + (make-list list-length 'make-list)) + (vector (make-vector vector-length 'make-vector)) + (bit-vector (make-bit-vector vector-length 1)) + (string (make-string string-length + (or (decode-char 'ucs #x20ac) ?\xFF))) + (item 'cons)) + (dolist (function '(count position find delete* remove* reduce)) + (Check-Error args-out-of-range + (funcall function item list +:start (1+ list-length) :end (1+ list-length))) + (Check-Error wrong-type-argument + (funcall function item list +:start -1 :end list-length)) + (Check-Error args-out-of-range + (funcall function item list :end (* 2 list-length))) + (Check-Error args-out-of-range + (funcall function item vector +:start (1+ vector-length) :end (1+ vector-length))) + (Check-Error wrong-type-argument + (funcall function item vector :start -1)) + (Check-Error args-out-of-range + (funcall function item vector :end (* 2 vector-length))) + (Check-Error args-out-of-range + (funcall function item bit-vector +:start (1+ vector-length) :end (1+ vector-length))) + (Check-Error wrong-type-argument + (funcall function item bit-vector :start -1)) + (Check-Error args-out-of-range + (funcall function item bit-vector :end (* 2 vector-length))) + (Check-Error args-out-of-range + (funcall function item string +:start (1+ string-length) :end (1+ string-length))) + (Check-Error wrong-type-argument + (funcall function item string :start -1)) + (Check-Error args-out-of-range + (funcall function item string :end (* 2 string-length)))) + (dolist (function '(delete-duplicates remove-duplicates)) + (Check-Error args-out-of-range + (funcall function (copy-sequence list) +:start (1+ list-length) :end (1+ list-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence list) +:start -1 :end list-length)) + (Check-Error args-out-of-range + (funcall function (copy-sequence list) +:end (* 2 list-length))) + (Check-Error args-out-of-range + (funcall function (copy-sequence vector) +:start (1+ vector-length) :end (1+ vector-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence vector) :start -1)) + (Check-Error args-out-of-range + (funcall function (copy-sequence vector) +:end (* 2 vector-length))) + (Check-Error args-out-of-range + (funcall function (copy-sequence bit-vector) +:start (1+ vector-length) :end (1+ vector-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence bit-vector) :start -1)) + (Check-Error args-out-of-range + (funcall function (copy-sequence bit-vector) +:end (* 2 vector-length))) + (Check-Error args-out-of-range + (funcall function (copy-sequence string) +:start (1+ string-length) :end (1+ string-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence string) :start -1)) + (Check-Error args-out-of-range + (funcall function (copy-sequence string) +:end (* 2 string-length)))) + (dolist (function '(replace mismatch search)) + (Check-Error args-out-of-range + (funcall function (copy-sequence list) (copy-sequence list) +:start1 (1+ list-length) :end1 (1+ list-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence list) (copy-sequence list) +:start1 -1 :end1 list-length)) + (Check-Error args-out-of-range + (funcall function (copy-sequence list) (copy-sequence list) +:end1 (* 2 list-length))) + (Check-Error args-out-of-range + (funcall function (copy-sequence vector) + (copy-sequence vector) :start1 (1+ vector-length) +:end1 (1+ vector-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence vector) + (copy-sequence vector) :start1 -1)) + (Check-Error args-out-of-range + (funcall function (copy-sequence vector) + (copy-sequence vector) +:end1 (* 2 vector-length))) + (Check-Error args-out-of-range + (funcall function (copy-sequence bit-vector) + (copy-sequence bit-vector) +:start1 (1+ vector-length) +:end1 (1+ vector-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence bit-vector) + (copy-sequence bit-vector) :start1 -1)) + (Check-Error args-out-of-range + (funcall function (copy-sequence bit-vector) + (copy-sequence bit-vector) +:end1 (* 2 vector-length))) + (Check-Error args-out-of-range + (funcall function (copy-sequence string) + (copy-sequence string) +:start1 (1+ string-length) +:end1 (1+ string-length))) + (Check-Error wrong-type-argument + (funcall function (copy-sequence string) + (copy-sequence string) :start1 -1)) + (Check-Error args-out-of-range + (funcall function (copy-sequence string) + (copy-sequence string) +:end1 (* 2 string-length)))))) + ;;; end of lisp-tests.el -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches