Mercurial > hg > xemacs-beta

diff 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
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Sat Feb 28 17:06:40 2015 -0800
+++ b/tests/automated/lisp-tests.el	Wed Mar 04 15:54:00 2015 +0000
@@ -2988,6 +2988,97 @@
   (Check-Error wrong-number-of-arguments
                (funcall list-and-four 7 8 9 10)))
 
+;; Test #'substitute. Paul Dietz has much more comprehensive tests.
+
+(Assert (equal (substitute 'a 'b '(a b c d e f g)) '(a a c d e f g)))
+(Assert (equal (substitute 'a 'b '(a b c d e b f g) :from-end t :count 1)
+               '(a b c d e a f g)))
+
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x)))
+                 (and (equal nomodif x) y))
+               '(z b c z b d z c b z e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :count nil)))
+                 (and (equal nomodif x) y))
+               '(z b c z b d z c b z e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :key nil)))
+                 (and (equal nomodif x) y))
+               '(z b c z b d z c b z e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :count 100)))
+                 (and (equal nomodif x) y))
+               '(z b c z b d z c b z e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :count 0)))
+                 (and (equal nomodif x) y))
+               '(a b c a b d a c b a e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :count 1)))
+                 (and (equal nomodif x) y))
+               '(z b c a b d a c b a e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'c x :count 1)))
+                 (and (equal nomodif x) y))
+               '(a b z a b d a c b a e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :from-end t)))
+                 (and (equal nomodif x) y))
+               '(z b c z b d z c b z e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :from-end t :count 1)))
+                 (and (equal nomodif x) y))
+               '(a b c a b d a c b z e)))
+(Assert (equal (let* ((nomodif '(a b c a b d a c b a e))
+                      (x (copy-list nomodif))
+                      (y (substitute 'z 'a x :from-end t :count 4)))
+                 (and (equal nomodif x) y))
+               '(z b c z b d z c b z e)))
+(Assert (equal (multiple-value-list
+                   (let* ((nomodif '(a b c a b d a c b a e))
+                          (x (copy-list nomodif)))
+                     (values
+                      (loop for i from 0 to 10
+                            collect (substitute 'z 'a x :start i))
+                      (equal nomodif x))))
+               '(((z b c z b d z c b z e) (a b c z b d z c b z e)
+                  (a b c z b d z c b z e) (a b c z b d z c b z e)
+                  (a b c a b d z c b z e) (a b c a b d z c b z e)
+                  (a b c a b d z c b z e) (a b c a b d a c b z e)
+                  (a b c a b d a c b z e) (a b c a b d a c b z e)
+                  (a b c a b d a c b a e))
+                 t)))
+(Assert (equal (multiple-value-list
+                   (let* ((nomodif '(a b c a b d a c b a e))
+                          (x (copy-list nomodif)))
+                     (values
+                      (loop for i from 0 to 10
+                            collect (substitute 'z 'a x :start i :end nil))
+                      (equal nomodif x))))
+               '(((z b c z b d z c b z e) (a b c z b d z c b z e)
+                  (a b c z b d z c b z e) (a b c z b d z c b z e)
+                  (a b c a b d z c b z e) (a b c a b d z c b z e)
+                  (a b c a b d z c b z e) (a b c a b d a c b z e)
+                  (a b c a b d a c b z e) (a b c a b d a c b z e)
+                  (a b c a b d a c b a e))
+                 t)))
+(Assert (equal
+         (let* ((nomodif '(1 2 3 2 6 1 2 4 1 3 2 7))
+                (x (copy-list nomodif))
+                (y (substitute 300 1 x :key #'1-)))
+           (and (equal nomodif x) y))
+         '(1 300 3 300 6 1 300 4 1 3 300 7)))
+
 ;; Test labels and inlining.
 (labels
     ((+ (&rest arguments)