Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5852:e9bb3688e654

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix some bugs in #'substitute, #'nsubstitute. src/ChangeLog addition: 2015-03-04 Aidan Kehoe <kehoea@parhasard.net> * sequence.c (count_with_tail): Accept COUNT from #'substitute, #'nsubstitute too. * sequence.c (FdeleteX): Only remove COUNT from the arguments if FROM-END is non-nil. * sequence.c (Fnsubstitute): Remove COUNT from the arguments if specified and FROM-END is non-nil. * sequence.c (Fsubstitute): Remove COUNT from the arguments if specified and FROM-END is non-nil. Do this before calling count_with_tail(). When we encounter the cons return by count_with_tail(), use the replacement object. tests/ChangeLog addition: 2015-03-04 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Add some tests for #'substitute.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 04 Mar 2015 15:54:00 +0000
parents cd4f5f1f1f4c
children a45722e74335
comparison
equal deleted inserted replaced
5851:eabf763bc6f9 5852:e9bb3688e654
2986 (Assert (equal (funcall list-and-four 5 6) '(21 1 2 7 5 . 6))) 2986 (Assert (equal (funcall list-and-four 5 6) '(21 1 2 7 5 . 6)))
2987 (Assert (equal (funcall list-and-four 7) '(17 1 2 7 7))) 2987 (Assert (equal (funcall list-and-four 7) '(17 1 2 7 7)))
2988 (Check-Error wrong-number-of-arguments 2988 (Check-Error wrong-number-of-arguments
2989 (funcall list-and-four 7 8 9 10))) 2989 (funcall list-and-four 7 8 9 10)))
2990 2990
2991 ;; Test #'substitute. Paul Dietz has much more comprehensive tests.
2992
2993 (Assert (equal (substitute 'a 'b '(a b c d e f g)) '(a a c d e f g)))
2994 (Assert (equal (substitute 'a 'b '(a b c d e b f g) :from-end t :count 1)
2995 '(a b c d e a f g)))
2996
2997 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
2998 (x (copy-list nomodif))
2999 (y (substitute 'z 'a x)))
3000 (and (equal nomodif x) y))
3001 '(z b c z b d z c b z e)))
3002 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3003 (x (copy-list nomodif))
3004 (y (substitute 'z 'a x :count nil)))
3005 (and (equal nomodif x) y))
3006 '(z b c z b d z c b z e)))
3007 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3008 (x (copy-list nomodif))
3009 (y (substitute 'z 'a x :key nil)))
3010 (and (equal nomodif x) y))
3011 '(z b c z b d z c b z e)))
3012 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3013 (x (copy-list nomodif))
3014 (y (substitute 'z 'a x :count 100)))
3015 (and (equal nomodif x) y))
3016 '(z b c z b d z c b z e)))
3017 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3018 (x (copy-list nomodif))
3019 (y (substitute 'z 'a x :count 0)))
3020 (and (equal nomodif x) y))
3021 '(a b c a b d a c b a e)))
3022 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3023 (x (copy-list nomodif))
3024 (y (substitute 'z 'a x :count 1)))
3025 (and (equal nomodif x) y))
3026 '(z b c a b d a c b a e)))
3027 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3028 (x (copy-list nomodif))
3029 (y (substitute 'z 'c x :count 1)))
3030 (and (equal nomodif x) y))
3031 '(a b z a b d a c b a e)))
3032 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3033 (x (copy-list nomodif))
3034 (y (substitute 'z 'a x :from-end t)))
3035 (and (equal nomodif x) y))
3036 '(z b c z b d z c b z e)))
3037 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3038 (x (copy-list nomodif))
3039 (y (substitute 'z 'a x :from-end t :count 1)))
3040 (and (equal nomodif x) y))
3041 '(a b c a b d a c b z e)))
3042 (Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
3043 (x (copy-list nomodif))
3044 (y (substitute 'z 'a x :from-end t :count 4)))
3045 (and (equal nomodif x) y))
3046 '(z b c z b d z c b z e)))
3047 (Assert (equal (multiple-value-list
3048 (let* ((nomodif '(a b c a b d a c b a e))
3049 (x (copy-list nomodif)))
3050 (values
3051 (loop for i from 0 to 10
3052 collect (substitute 'z 'a x :start i))
3053 (equal nomodif x))))
3054 '(((z b c z b d z c b z e) (a b c z b d z c b z e)
3055 (a b c z b d z c b z e) (a b c z b d z c b z e)
3056 (a b c a b d z c b z e) (a b c a b d z c b z e)
3057 (a b c a b d z c b z e) (a b c a b d a c b z e)
3058 (a b c a b d a c b z e) (a b c a b d a c b z e)
3059 (a b c a b d a c b a e))
3060 t)))
3061 (Assert (equal (multiple-value-list
3062 (let* ((nomodif '(a b c a b d a c b a e))
3063 (x (copy-list nomodif)))
3064 (values
3065 (loop for i from 0 to 10
3066 collect (substitute 'z 'a x :start i :end nil))
3067 (equal nomodif x))))
3068 '(((z b c z b d z c b z e) (a b c z b d z c b z e)
3069 (a b c z b d z c b z e) (a b c z b d z c b z e)
3070 (a b c a b d z c b z e) (a b c a b d z c b z e)
3071 (a b c a b d z c b z e) (a b c a b d a c b z e)
3072 (a b c a b d a c b z e) (a b c a b d a c b z e)
3073 (a b c a b d a c b a e))
3074 t)))
3075 (Assert (equal
3076 (let* ((nomodif '(1 2 3 2 6 1 2 4 1 3 2 7))
3077 (x (copy-list nomodif))
3078 (y (substitute 300 1 x :key #'1-)))
3079 (and (equal nomodif x) y))
3080 '(1 300 3 300 6 1 300 4 1 3 300 7)))
3081
2991 ;; Test labels and inlining. 3082 ;; Test labels and inlining.
2992 (labels 3083 (labels
2993 ((+ (&rest arguments) 3084 ((+ (&rest arguments)
2994 ;; Shades of Java, hah. 3085 ;; Shades of Java, hah.
2995 (mapconcat #'prin1-to-string arguments ", ")) 3086 (mapconcat #'prin1-to-string arguments ", "))