From 2417ce71fc3978ef61f57e70a2e207f8f83a3a15 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 3 Nov 2002 11:46:46 +0000 Subject: [PATCH] Added more tests for FILL. Two tests are failing (fill.string.9 and fill.string.10) because FILL is not respecting the fill-pointer on character strings. --- ansi-tests/fill.lsp | 174 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 172 insertions(+), 2 deletions(-) diff --git a/ansi-tests/fill.lsp b/ansi-tests/fill.lsp index 8266655f..30d1a5c8 100644 --- a/ansi-tests/fill.lsp +++ b/ansi-tests/fill.lsp @@ -238,9 +238,179 @@ t "zzzzz") +(deftest fill.string.5 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for start from 0 to (1- len) + always + (loop for end from (1+ start) to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :start start :end end))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :start start :end end)) + t))))) + t) + +(deftest fill.string.6 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :start start))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :start start)) + t)))) + t) + +(deftest fill.string.7 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :end nil :start start))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :end nil :start start)) + t)))) + t) + +(deftest fill.string.8 + (let* ((s1 "aaaaaaaa") + (len (length s1))) + (loop for end from 1 to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 #\z :end end))) + (and (eqt s2 s3) + (string= s3 + (substitute-if #\z (constantly t) s1 + :end end)) + t)))) + t) + +(deftest fill.string.9 + (let* ((s1 (make-array '(8) :element-type 'character + :initial-element #\a + :fill-pointer 4)) + (s2 (fill s1 #\a))) + (and (eqt s1 s2) + (coerce (loop for i from 0 to 7 collect (aref s2 i)) + 'string))) + "aaaazzzz") + +(deftest fill.string.10 + (let* ((s1 (make-array '(8) :element-type 'base-char + :initial-element #\a + :fill-pointer 4)) + (s2 (fill s1 #\a))) + (and (eqt s1 s2) + (coerce (loop for i from 0 to 7 collect (aref s2 i)) + 'base-string))) + "aaaazzzz") + +;;; Tests for bit vectors + +(deftest fill.bit-vector.1 + (let* ((s1 (copy-seq #*01100)) + (s2 (fill s1 0))) + (values (eqt s1 s2) s2)) + t + #*00000) +(deftest fill.bit-vector.2 + (let* ((s1 (copy-seq #*00100)) + (s2 (fill s1 1 :start 0 :end 1))) + (values (eqt s1 s2) s2)) + t + #*10100) +(deftest fill.bit-vector.3 + (let* ((s1 (copy-seq #*00010)) + (s2 (fill s1 1 :end 2))) + (values (eqt s1 s2) s2)) + t + #*11010) +(deftest fill.bit-vector.4 + (let* ((s1 (copy-seq #*00111)) + (s2 (fill s1 0 :end nil))) + (values (eqt s1 s2) s2)) + t + #*00000) + +(deftest fill.bit-vector.5 + (let* ((s1 #*00000000) + (len (length s1))) + (loop for start from 0 to (1- len) + always + (loop for end from (1+ start) to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 1 :start start :end end))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 1 (constantly t) s1 + :start start :end end)) + t))))) + t) + +(deftest fill.bit-vector.6 + (let* ((s1 #*11111111) + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 0 :start start))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 0 (constantly t) s1 + :start start)) + t)))) + t) + +(deftest fill.bit-vector.7 + (let* ((s1 #*00000000) + (len (length s1))) + (loop for start from 0 to (1- len) + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 1 :end nil :start start))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 1 (constantly t) s1 + :end nil :start start)) + t)))) + t) + +(deftest fill.bit-vector.8 + (let* ((s1 #*11111111) + (len (length s1))) + (loop for end from 1 to len + always + (let* ((s2 (copy-seq s1)) + (s3 (fill s2 0 :end end))) + (and (eqt s2 s3) + (equalp s3 + (substitute-if 0 (constantly t) s1 + :end end)) + t)))) + t) + +(deftest fill.bit-vector.9 + (let* ((s1 (make-array '(8) :element-type 'bit + :initial-element 0 + :fill-pointer 4)) + (s2 (fill s1 1))) + (and (eqt s1 s2) + (coerce (loop for i from 0 to 7 collect (aref s2 i)) + 'bit-vector))) + #*11110000) - - -- GitLab