[COMMIT] Fix some bugs in #'substitute, #'nsubstitute.

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1425484440 0 # Wed Mar 04 15:54:00 2015 +0000 # Node ID e9bb3688e654d8f944fbf2943f9f9d030e272501 # Parent eabf763bc6f95812d41b72436de9cd1ab73f7737 Fix some bugs in #'substitute, #'nsubstitute. src/ChangeLog addition: 2015-03-04 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * automated/lisp-tests.el: Add some tests for #'substitute. diff -r eabf763bc6f9 -r e9bb3688e654 src/ChangeLog --- a/src/ChangeLog Sat Feb 28 17:06:40 2015 -0800 +++ b/src/ChangeLog Wed Mar 04 15:54:00 2015 +0000 ＠＠ -1,3 +1,18 ＠＠ +2015-03-04 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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. + 2015-01-08 Stephen J. Turnbull <stephen(a)xemacs.org&gt; Fix progress bar crashes. diff -r eabf763bc6f9 -r e9bb3688e654 src/sequence.c --- a/src/sequence.c Sat Feb 28 17:06:40 2015 -0800 +++ b/src/sequence.c Wed Mar 04 15:54:00 2015 +0000 ＠＠ -710,9 +710,6 ＠＠ /* Our callers should have filtered out non-positive COUNT. */ assert (counting >= 0); - /* And we're not prepared to handle COUNT from any other caller at the - moment. */ - assert (EQ (caller, QremoveX)|| EQ (caller, QdeleteX)); } check_test = get_check_test_function (item, &test, test_not, if_, if_not, ＠＠ -1878,7 +1875,7 ＠＠ PARSE_KEYWORDS (FdeleteX, nargs, args, 9, (test, if_not, if_, test_not, key, start, end, from_end, - count), (start = Qzero, count = Qunbound)); + count), (start = Qzero)); CHECK_SEQUENCE (sequence); CHECK_NATNUM (start); ＠＠ -1890,45 +1887,41 ＠＠ ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end); } - if (!UNBOUNDP (count)) - { - if (!NILP (count)) - { - CHECK_INTEGER (count); - if (FIXNUMP (count)) + if (!NILP (count)) + { + CHECK_INTEGER (count); + if (FIXNUMP (count)) + { + counting = XFIXNUM (count); + } +#ifdef HAVE_BIGNUM + else + { + counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? + 1 + MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM - 1; + } +#endif + if (counting < 1) + { + return sequence; + } + + if (!NILP (from_end)) + { + /* Sigh, this is inelegant. Force count_with_tail () to ignore + the count keyword, so we get the actual number of matching + elements, and can start removing from the beginning for the + from-end case. */ + for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args; + ii < nargs; ii += 2) { - counting = XFIXNUM (count); + if (EQ (args[ii], Q_count)) + { + args[ii + 1] = Qnil; + break; + } } -#ifdef HAVE_BIGNUM - else - { - counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? - 1 + MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM - 1; - } -#endif - - if (counting < 1) - { - return sequence; - } - - if (!NILP (from_end)) - { - /* Sigh, this is inelegant. Force count_with_tail () to ignore - the count keyword, so we get the actual number of matching - elements, and can start removing from the beginning for the - from-end case. */ - for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args; - ii < nargs; ii += 2) - { - if (EQ (args[ii], Q_count)) - { - args[ii + 1] = Qnil; - break; - } - } - ii = 0; - } + ii = 0; } } ＠＠ -5797,6 +5790,20 ＠＠ { return sequence; } + + if (!NILP (from_end)) + { + for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (Fnsubstitute))->min_args; + ii < nargs; ii += 2) + { + if (EQ (args[ii], Q_count)) + { + args[ii + 1] = Qnil; + break; + } + } + ii = 0; + } } check_test = get_check_test_function (item, &test, test_not, if_, if_not, ＠＠ -6015,16 +6022,16 ＠＠ { Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil; Lisp_Object result = Qnil, result_tail = Qnil; - Lisp_Object object, position0, matched_count; + Lisp_Object object, position0, matched; Elemcount starting = 0, ending = MOST_POSITIVE_FIXNUM, encountered = 0; - Elemcount ii = 0, counting = MOST_POSITIVE_FIXNUM, presenting = 0; + Elemcount ii = 0, counting = MOST_POSITIVE_FIXNUM, skipping = 0; Boolint test_not_unboundp = 1; check_test_func_t check_test = NULL; struct gcpro gcpro1; PARSE_KEYWORDS (Fsubstitute, nargs, args, 9, (test, if_, if_not, test_not, key, start, end, count, - from_end), (start = Qzero, count = Qunbound)); + from_end), (start = Qzero)); CHECK_SEQUENCE (sequence); ＠＠ -6040,30 +6047,6 ＠＠ check_test = get_check_test_function (item, &test, test_not, if_, if_not, key, &test_not_unboundp); - if (!UNBOUNDP (count)) - { - if (!NILP (count)) - { - CHECK_INTEGER (count); - if (FIXNUMP (count)) - { - counting = XFIXNUM (count); - } -#ifdef HAVE_BIGNUM - else - { - counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? - 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM; - } -#endif - - if (counting <= 0) - { - return sequence; - } - } - } - if (!CONSP (sequence)) { position0 = position (&object, item, sequence, check_test, ＠＠ -6081,17 +6064,62 ＠＠ } } - matched_count = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute); - - if (ZEROP (matched_count)) + if (!NILP (count)) + { + CHECK_INTEGER (count); + if (FIXNUMP (count)) + { + counting = XFIXNUM (count); + } +#ifdef HAVE_BIGNUM + else + { + counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ? + 1 + MOST_POSITIVE_FIXNUM : -1 + MOST_NEGATIVE_FIXNUM; + } +#endif + + if (counting <= 0) + { + return sequence; + } + + /* Sigh, this is inelegant. Force count_with_tail () to ignore the count + keyword, so we get the actual number of matching elements, and can + start removing from the beginning for the from-end case. */ + if (!NILP (from_end)) + { + for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (Fsubstitute))->min_args; + ii < nargs; ii += 2) + { + if (EQ (args[ii], Q_count)) + { + args[ii + 1] = Qnil; + break; + } + } + ii = 0; + } + } + + matched = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute); + + if (ZEROP (matched)) { return sequence; } if (!NILP (count) && !NILP (from_end)) { - presenting = XFIXNUM (matched_count); - presenting = presenting <= counting ? 0 : presenting - counting; + Elemcount matching = XFIXNUM (matched); + if (matching > counting) + { + /* skipping is the number of elements to be skipped before we start + substituting. It is for those cases where both :count and +:from-end are specified, and the number of elements present is + greater than that limit specified with :count. */ + skipping = matching - counting; + } } GCPRO1 (result); ＠＠ -6100,20 +6128,32 ＠＠ { if (EQ (tail, tailing)) { + /* No need to do check_test, we're sure that this element matches + because its cons is what count_with_tail returned as the + tail. */ + if (skipping ? encountered >= skipping : encountered < counting) + { + if (NILP (result)) + { + result = Fcons (new_, XCDR (tail)); + } + else + { + XSETCDR (result_tail, Fcons (new_, XCDR (tail))); + } + } + else + { + XSETCDR (result_tail, tail); + } + XUNGCPRO (elt); UNGCPRO; - - if (NILP (result)) - { - return XCDR (tail); - } - - XSETCDR (result_tail, XCDR (tail)); - return result; + return result; } else if (starting <= ii && ii < ending && (check_test (test, key, item, elt) == test_not_unboundp) - && (presenting ? encountered++ >= presenting + && (skipping ? encountered++ >= skipping : encountered++ < counting)) { if (NILP (result)) diff -r eabf763bc6f9 -r e9bb3688e654 tests/ChangeLog --- a/tests/ChangeLog Sat Feb 28 17:06:40 2015 -0800 +++ b/tests/ChangeLog Wed Mar 04 15:54:00 2015 +0000 ＠＠ -1,3 +1,8 ＠＠ +2015-03-04 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Add some tests for #'substitute. + 2014-10-11 Stephen J. Turnbull <stephen(a)xemacs.org&gt; * automated/keymap-tests.el: diff -r eabf763bc6f9 -r e9bb3688e654 tests/automated/lisp-tests.el --- 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) -- ‘Tramadol is further fed to cattle […] when working them […] (as draft animals) so that the animals do not get tired quickly. …’ — Angewandte Chemie, Sept 2014, describing the social context of (synthetic) tramadol having been found in Cameroon tree roots. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches