292 |
result) |
result) |
293 |
#(a b z c b)) |
#(a b z c b)) |
294 |
|
|
295 |
|
(deftest substitute-if-vector.32 |
296 |
|
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d))) |
297 |
|
(v2 (make-array '(8) :displaced-to v1 |
298 |
|
:displaced-index-offset 3))) |
299 |
|
(values |
300 |
|
(substitute-if 'x (is-eql-p 'c) v2 :count 1) |
301 |
|
v1)) |
302 |
|
#(d a b x d a b c) |
303 |
|
#(a b c d a b c d a b c d a b c d)) |
304 |
|
|
305 |
|
(deftest substitute-if-vector.33 |
306 |
|
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d))) |
307 |
|
(v2 (make-array '(8) :displaced-to v1 |
308 |
|
:displaced-index-offset 3))) |
309 |
|
(values |
310 |
|
(substitute-if 'x (is-eql-p 'c) v2 :count 1 :from-end t) |
311 |
|
v1)) |
312 |
|
#(d a b c d a b x) |
313 |
|
#(a b c d a b c d a b c d a b c d)) |
314 |
|
|
315 |
;;; Tests on strings |
;;; Tests on strings |
316 |
|
|
317 |
(deftest substitute-if-string.1 |
(deftest substitute-if-string.1 |
711 |
result)) |
result)) |
712 |
"01a2342015") |
"01a2342015") |
713 |
|
|
714 |
(deftest substitute-if-bit-vector.26 |
(deftest substitute-if-string.26 |
715 |
|
(do-special-strings |
716 |
|
(s "xyzabcxyzabc" nil) |
717 |
|
(assert (string= (substitute-if #\! (is-eql-p #\a) s) "xyz!bcxyz!bc")) |
718 |
|
(assert (string= (substitute-if #\! (is-eql-p #\a) s :count 1) "xyz!bcxyzabc")) |
719 |
|
(assert (string= (substitute-if #\! (is-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc")) |
720 |
|
(assert (string= s "xyzabcxyzabc"))) |
721 |
|
nil) |
722 |
|
|
723 |
|
;;; More bit vector tests |
724 |
|
|
725 |
|
(deftest substitute-if-bit-vector.22 |
726 |
(let* ((orig #*00111001011010110) |
(let* ((orig #*00111001011010110) |
727 |
(x (copy-seq orig)) |
(x (copy-seq orig)) |
728 |
(result (substitute-if 1 (is-eql-p 1) x :key #'1+))) |
(result (substitute-if 1 (is-eql-p 1) x :key #'1+))) |
730 |
result)) |
result)) |
731 |
#*11111111111111111) |
#*11111111111111111) |
732 |
|
|
733 |
(deftest substitute-if-bit-vector.27 |
(deftest substitute-if-bit-vector.23 |
734 |
(let* ((orig #*00111001011010110) |
(let* ((orig #*00111001011010110) |
735 |
(x (copy-seq orig)) |
(x (copy-seq orig)) |
736 |
(result (substitute-if 1 (is-eql-p 1) x :key #'1+ :start 1 :end 10))) |
(result (substitute-if 1 (is-eql-p 1) x :key #'1+ :start 1 :end 10))) |
738 |
result)) |
result)) |
739 |
#*01111111111010110) |
#*01111111111010110) |
740 |
|
|
741 |
(deftest substitute-if-bit-vector.30 |
(deftest substitute-if-bit-vector.24 |
742 |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
743 |
:fill-pointer 5 :element-type 'bit)) |
:fill-pointer 5 :element-type 'bit)) |
744 |
(result (substitute-if 1 #'zerop x))) |
(result (substitute-if 1 #'zerop x))) |
745 |
result) |
result) |
746 |
#*11111) |
#*11111) |
747 |
|
|
748 |
(deftest substitute-if-bit-vector.31 |
(deftest substitute-if-bit-vector.25 |
749 |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
750 |
:fill-pointer 5 :element-type 'bit)) |
:fill-pointer 5 :element-type 'bit)) |
751 |
(result (substitute-if 1 #'zerop x :from-end t))) |
(result (substitute-if 1 #'zerop x :from-end t))) |
752 |
result) |
result) |
753 |
#*11111) |
#*11111) |
754 |
|
|
755 |
(deftest substitute-if-bit-vector.32 |
(deftest substitute-if-bit-vector.26 |
756 |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
757 |
:fill-pointer 5 :element-type 'bit)) |
:fill-pointer 5 :element-type 'bit)) |
758 |
(result (substitute-if 1 #'zerop x :count 1))) |
(result (substitute-if 1 #'zerop x :count 1))) |
759 |
result) |
result) |
760 |
#*11011) |
#*11011) |
761 |
|
|
762 |
(deftest substitute-if-bit-vector.33 |
(deftest substitute-if-bit-vector.27 |
763 |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1) |
764 |
:fill-pointer 5 :element-type 'bit)) |
:fill-pointer 5 :element-type 'bit)) |
765 |
(result (substitute-if 1 #'zerop x :from-end t :count 1))) |
(result (substitute-if 1 #'zerop x :from-end t :count 1))) |
766 |
result) |
result) |
767 |
#*01111) |
#*01111) |
768 |
|
|
769 |
|
;;; Order of evaluation tests |
770 |
|
|
771 |
(deftest substitute-if.order.1 |
(deftest substitute-if.order.1 |
772 |
(let ((i 0) a b c d e f g h) |
(let ((i 0) a b c d e f g h) |
773 |
(values |
(values |