tests/seq.pure.lisp

   1 ;;;; tests related to sequences
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 ;;; As reported by Paul Dietz from his ansi-test suite for gcl, REMOVE
  15 ;;; malfunctioned when given :START, :END and :FROM-END arguments.
  16 ;;; Make sure it doesn't happen again.
  17 (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
  18        (x (copy-seq orig))
  19        (y (remove 3 x :from-end t :start 1 :end 5))
  20        (z (remove 2 x :from-end t :start 1 :end 5)))
  21   (assert (equalp orig x))
  22   (assert (equalp y '(1 2 2 6 1 2 4 1 3 2 7)))
  23   (assert (equalp z '(1 3 6 1 2 4 1 3 2 7))))
  24
  25 ;;; Similarly, NSUBSTITUTE and friends were getting things wrong with
  26 ;;; :START, :END and :FROM-END:
  27 (assert
  28  (loop for i from 0 to 9 always
  29        (loop for j from i to 10 always
  30              (loop for c from 0 to (- j i) always
  31                    (let* ((orig '(a a a a a a a a a a))
  32                           (x (copy-seq orig))
  33                           (y (nsubstitute 'x 'a x :start i :end j :count c)))
  34                      (equal y (nconc (make-list i :initial-element 'a)
  35                                      (make-list c :initial-element 'x)
  36                                      (make-list (- 10 (+ i c))
  37                                                 :initial-element 'a))))))))
  38
  39 (assert
  40  (loop for i from 0 to 9 always
  41        (loop for j from i to 10 always
  42              (loop for c from 0 to (- j i) always
  43                    (let* ((orig '(a a a a a a a a a a))
  44                           (x (copy-seq orig))
  45                           (y (nsubstitute-if 'x (lambda (x) (eq x 'a)) x
  46                                              :start i :end j
  47                                              :count c :from-end t)))
  48                      (equal y (nconc (make-list (- j c) :initial-element 'a)
  49                                      (make-list c :initial-element 'x)
  50                                      (make-list (- 10 j)
  51                                                 :initial-element 'a))))))))
  52 (assert
  53  (loop for i from 0 to 9 always
  54        (loop for j from i to 10 always
  55              (loop for c from 0 to (- j i) always
  56                    (let* ((orig '(a a a a a a a a a a))
  57                           (x (copy-seq orig))
  58                           (y (nsubstitute-if-not 'x (lambda (x)
  59                                                       (not (eq x 'a))) x
  60                                                  :start i :end j
  61                                                  :count c :from-end t)))
  62                      (equal y (nconc (make-list (- j c) :initial-element 'a)
  63                                      (make-list c :initial-element 'x)
  64                                      (make-list (- 10 j)
  65                                                 :initial-element 'a))))))))
  66