Mercurial > hg > xemacs-beta
comparison tests/automated/lisp-tests.el @ 5347:fd441b85d760
Loop at macroexpansion time when sanity-checking :start, :end keyword args.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
When sanity-checking :start and :end keyword arguments, loop at
macroexpansion time, not runtime, allowing us to pick up any
compiler macros and giving a clearer *Test-Log* buffer.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 23 Jan 2011 13:56:37 +0000 |
| parents | b4ef3128160c |
| children | 38e24b8be4ea |
comparison
equal
deleted
inserted
replaced
| 5346:b4ef3128160c | 5347:fd441b85d760 |
|---|---|
| 2680 (vector (make-vector vector-length 'make-vector)) | 2680 (vector (make-vector vector-length 'make-vector)) |
| 2681 (bit-vector (make-bit-vector vector-length 1)) | 2681 (bit-vector (make-bit-vector vector-length 1)) |
| 2682 (string (make-string string-length | 2682 (string (make-string string-length |
| 2683 (or (decode-char 'ucs #x20ac) ?\xFF))) | 2683 (or (decode-char 'ucs #x20ac) ?\xFF))) |
| 2684 (item 'cons)) | 2684 (item 'cons)) |
| 2685 (dolist (function '(count position find delete* remove* reduce)) | 2685 (macrolet |
| 2686 (Check-Error args-out-of-range | 2686 ((construct-item-sequence-checks (&rest functions) |
| 2687 (funcall function item list | 2687 (cons |
| 2688 :start (1+ list-length) :end (1+ list-length))) | 2688 'progn |
| 2689 (Check-Error wrong-type-argument | 2689 (mapcan |
| 2690 (funcall function item list | 2690 #'(lambda (function) |
| 2691 :start -1 :end list-length)) | 2691 `((Check-Error args-out-of-range |
| 2692 (Check-Error args-out-of-range | 2692 (,function item list |
| 2693 (funcall function item list :end (* 2 list-length))) | 2693 :start (1+ list-length) |
| 2694 (Check-Error args-out-of-range | 2694 :end (1+ list-length))) |
| 2695 (funcall function item vector | 2695 (Check-Error wrong-type-argument |
| 2696 :start (1+ vector-length) :end (1+ vector-length))) | 2696 (,function item list :start -1 |
| 2697 (Check-Error wrong-type-argument | 2697 :end list-length)) |
| 2698 (funcall function item vector :start -1)) | 2698 (Check-Error args-out-of-range |
| 2699 (Check-Error args-out-of-range | 2699 (,function item list :end (* 2 list-length))) |
| 2700 (funcall function item vector :end (* 2 vector-length))) | 2700 (Check-Error args-out-of-range |
| 2701 (Check-Error args-out-of-range | 2701 (,function item vector |
| 2702 (funcall function item bit-vector | 2702 :start (1+ vector-length) |
| 2703 :start (1+ vector-length) :end (1+ vector-length))) | 2703 :end (1+ vector-length))) |
| 2704 (Check-Error wrong-type-argument | 2704 (Check-Error wrong-type-argument |
| 2705 (funcall function item bit-vector :start -1)) | 2705 (,function item vector :start -1)) |
| 2706 (Check-Error args-out-of-range | 2706 (Check-Error args-out-of-range |
| 2707 (funcall function item bit-vector :end (* 2 vector-length))) | 2707 (,function item vector |
| 2708 (Check-Error args-out-of-range | 2708 :end (* 2 vector-length))) |
| 2709 (funcall function item string | 2709 (Check-Error args-out-of-range |
| 2710 :start (1+ string-length) :end (1+ string-length))) | 2710 (,function item bit-vector |
| 2711 (Check-Error wrong-type-argument | 2711 :start (1+ vector-length) |
| 2712 (funcall function item string :start -1)) | 2712 :end (1+ vector-length))) |
| 2713 (Check-Error args-out-of-range | 2713 (Check-Error wrong-type-argument |
| 2714 (funcall function item string :end (* 2 string-length)))) | 2714 (,function item bit-vector :start -1)) |
| 2715 (dolist (function '(delete-duplicates remove-duplicates)) | 2715 (Check-Error args-out-of-range |
| 2716 (Check-Error args-out-of-range | 2716 (,function item bit-vector |
| 2717 (funcall function (copy-sequence list) | 2717 :end (* 2 vector-length))) |
| 2718 :start (1+ list-length) :end (1+ list-length))) | 2718 (Check-Error args-out-of-range |
| 2719 (Check-Error wrong-type-argument | 2719 (,function item string |
| 2720 (funcall function (copy-sequence list) | 2720 :start (1+ string-length) |
| 2721 :start -1 :end list-length)) | 2721 :end (1+ string-length))) |
| 2722 (Check-Error args-out-of-range | 2722 (Check-Error wrong-type-argument |
| 2723 (funcall function (copy-sequence list) | 2723 (,function item string :start -1)) |
| 2724 :end (* 2 list-length))) | 2724 (Check-Error args-out-of-range |
| 2725 (Check-Error args-out-of-range | 2725 (,function item string |
| 2726 (funcall function (copy-sequence vector) | 2726 :end (* 2 string-length))))) |
| 2727 :start (1+ vector-length) :end (1+ vector-length))) | 2727 functions))) |
| 2728 (Check-Error wrong-type-argument | 2728 (construct-one-sequence-checks (&rest functions) |
| 2729 (funcall function (copy-sequence vector) :start -1)) | 2729 (cons |
| 2730 (Check-Error args-out-of-range | 2730 'progn |
| 2731 (funcall function (copy-sequence vector) | 2731 (mapcan |
| 2732 :end (* 2 vector-length))) | 2732 #'(lambda (function) |
| 2733 (Check-Error args-out-of-range | 2733 `((Check-Error args-out-of-range |
| 2734 (funcall function (copy-sequence bit-vector) | 2734 (,function (copy-sequence list) |
| 2735 :start (1+ vector-length) :end (1+ vector-length))) | 2735 :start (1+ list-length) |
| 2736 (Check-Error wrong-type-argument | 2736 :end (1+ list-length))) |
| 2737 (funcall function (copy-sequence bit-vector) :start -1)) | 2737 (Check-Error wrong-type-argument |
| 2738 (Check-Error args-out-of-range | 2738 (,function (copy-sequence list) |
| 2739 (funcall function (copy-sequence bit-vector) | 2739 :start -1 :end list-length)) |
| 2740 :end (* 2 vector-length))) | 2740 (Check-Error args-out-of-range |
| 2741 (Check-Error args-out-of-range | 2741 (,function (copy-sequence list) |
| 2742 (funcall function (copy-sequence string) | 2742 :end (* 2 list-length))) |
| 2743 :start (1+ string-length) :end (1+ string-length))) | 2743 (Check-Error args-out-of-range |
| 2744 (Check-Error wrong-type-argument | 2744 (,function (copy-sequence vector) |
| 2745 (funcall function (copy-sequence string) :start -1)) | 2745 :start (1+ vector-length) |
| 2746 (Check-Error args-out-of-range | 2746 :end (1+ vector-length))) |
| 2747 (funcall function (copy-sequence string) | 2747 (Check-Error wrong-type-argument |
| 2748 :end (* 2 string-length)))) | 2748 (,function (copy-sequence vector) :start -1)) |
| 2749 (dolist (function '(replace mismatch search)) | 2749 (Check-Error args-out-of-range |
| 2750 (Check-Error args-out-of-range | 2750 (,function (copy-sequence vector) |
| 2751 (funcall function (copy-sequence list) (copy-sequence list) | 2751 :end (* 2 vector-length))) |
| 2752 :start1 (1+ list-length) :end1 (1+ list-length))) | 2752 (Check-Error args-out-of-range |
| 2753 (Check-Error wrong-type-argument | 2753 (,function (copy-sequence bit-vector) |
| 2754 (funcall function (copy-sequence list) (copy-sequence list) | 2754 :start (1+ vector-length) |
| 2755 :start1 -1 :end1 list-length)) | 2755 :end (1+ vector-length))) |
| 2756 (Check-Error args-out-of-range | 2756 (Check-Error wrong-type-argument |
| 2757 (funcall function (copy-sequence list) (copy-sequence list) | 2757 (,function (copy-sequence bit-vector) |
| 2758 :end1 (* 2 list-length))) | 2758 :start -1)) |
| 2759 (Check-Error args-out-of-range | 2759 (Check-Error args-out-of-range |
| 2760 (funcall function (copy-sequence vector) | 2760 (,function (copy-sequence bit-vector) |
| 2761 (copy-sequence vector) :start1 (1+ vector-length) | 2761 :end (* 2 vector-length))) |
| 2762 :end1 (1+ vector-length))) | 2762 (Check-Error args-out-of-range |
| 2763 (Check-Error wrong-type-argument | 2763 (,function (copy-sequence string) |
| 2764 (funcall function (copy-sequence vector) | 2764 :start (1+ string-length) |
| 2765 (copy-sequence vector) :start1 -1)) | 2765 :end (1+ string-length))) |
| 2766 (Check-Error args-out-of-range | 2766 (Check-Error wrong-type-argument |
| 2767 (funcall function (copy-sequence vector) | 2767 (,function (copy-sequence string) :start -1)) |
| 2768 (copy-sequence vector) | 2768 (Check-Error args-out-of-range |
| 2769 :end1 (* 2 vector-length))) | 2769 (,function (copy-sequence string) |
| 2770 (Check-Error args-out-of-range | 2770 :end (* 2 string-length))))) |
| 2771 (funcall function (copy-sequence bit-vector) | 2771 functions))) |
| 2772 (copy-sequence bit-vector) | 2772 (construct-two-sequence-checks (&rest functions) |
| 2773 :start1 (1+ vector-length) | 2773 (cons |
| 2774 :end1 (1+ vector-length))) | 2774 'progn |
| 2775 (Check-Error wrong-type-argument | 2775 (mapcan |
| 2776 (funcall function (copy-sequence bit-vector) | 2776 #'(lambda (function) |
| 2777 (copy-sequence bit-vector) :start1 -1)) | 2777 `((Check-Error args-out-of-range |
| 2778 (Check-Error args-out-of-range | 2778 (,function (copy-sequence list) |
| 2779 (funcall function (copy-sequence bit-vector) | 2779 (copy-sequence list) |
| 2780 (copy-sequence bit-vector) | 2780 :start1 (1+ list-length) |
| 2781 :end1 (* 2 vector-length))) | 2781 :end1 (1+ list-length))) |
| 2782 (Check-Error args-out-of-range | 2782 (Check-Error wrong-type-argument |
| 2783 (funcall function (copy-sequence string) | 2783 (,function (copy-sequence list) |
| 2784 (copy-sequence string) | 2784 (copy-sequence list) |
| 2785 :start1 (1+ string-length) | 2785 :start1 -1 :end1 list-length)) |
| 2786 :end1 (1+ string-length))) | 2786 (Check-Error args-out-of-range |
| 2787 (Check-Error wrong-type-argument | 2787 (,function (copy-sequence list) |
| 2788 (funcall function (copy-sequence string) | 2788 (copy-sequence list) |
| 2789 (copy-sequence string) :start1 -1)) | 2789 :end1 (* 2 list-length))) |
| 2790 (Check-Error args-out-of-range | 2790 (Check-Error args-out-of-range |
| 2791 (funcall function (copy-sequence string) | 2791 (,function (copy-sequence vector) |
| 2792 (copy-sequence string) | 2792 (copy-sequence vector) |
| 2793 :end1 (* 2 string-length)))))) | 2793 :start1 (1+ vector-length) |
| 2794 :end1 (1+ vector-length))) | |
| 2795 (Check-Error wrong-type-argument | |
| 2796 (,function | |
| 2797 (copy-sequence vector) | |
| 2798 (copy-sequence vector) :start1 -1)) | |
| 2799 (Check-Error args-out-of-range | |
| 2800 (,function (copy-sequence vector) | |
| 2801 (copy-sequence vector) | |
| 2802 :end1 (* 2 vector-length))) | |
| 2803 (Check-Error args-out-of-range | |
| 2804 (,function (copy-sequence bit-vector) | |
| 2805 (copy-sequence bit-vector) | |
| 2806 :start1 (1+ vector-length) | |
| 2807 :end1 (1+ vector-length))) | |
| 2808 (Check-Error wrong-type-argument | |
| 2809 (,function (copy-sequence bit-vector) | |
| 2810 (copy-sequence bit-vector) | |
| 2811 :start1 -1)) | |
| 2812 (Check-Error args-out-of-range | |
| 2813 (,function (copy-sequence bit-vector) | |
| 2814 (copy-sequence bit-vector) | |
| 2815 :end1 (* 2 vector-length))) | |
| 2816 (Check-Error args-out-of-range | |
| 2817 (,function (copy-sequence string) | |
| 2818 (copy-sequence string) | |
| 2819 :start1 (1+ string-length) | |
| 2820 :end1 (1+ string-length))) | |
| 2821 (Check-Error wrong-type-argument | |
| 2822 (,function (copy-sequence string) | |
| 2823 (copy-sequence string) :start1 -1)) | |
| 2824 (Check-Error args-out-of-range | |
| 2825 (,function (copy-sequence string) | |
| 2826 (copy-sequence string) | |
| 2827 :end1 (* 2 string-length))))) | |
| 2828 functions)))) | |
| 2829 (construct-item-sequence-checks count position find delete* remove* | |
| 2830 reduce) | |
| 2831 (construct-one-sequence-checks delete-duplicates remove-duplicates) | |
| 2832 (construct-two-sequence-checks replace mismatch search)))) | |
| 2794 | 2833 |
| 2795 (let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone)) | 2834 (let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone)) |
| 2796 (vector (map 'vector #'identity list)) | 2835 (vector (map 'vector #'identity list)) |
| 2797 (bit-vector (map 'bit-vector | 2836 (bit-vector (map 'bit-vector |
| 2798 #'(lambda (object) (if (fixnump object) 1 0)) list)) | 2837 #'(lambda (object) (if (fixnump object) 1 0)) list)) |