diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp new file mode 100644 index 0000000000000000000000000000000000000000..d83edcf7b6fd19ab3352e2b74d9ae33c7db68a82 --- /dev/null +++ b/ansi-tests/copy-seq.lsp @@ -0,0 +1,163 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 2 21:38:08 2002 +;;;; Contains: Tests for COPY-SEQ + +(in-package :cl-test) + +;;; This function is extensively used elsewhere, but is tested again +;;; here for completeness. + +(deftest copy-seq.1 + (copy-seq nil) + nil) + +(deftest copy-seq.2 + (let* ((s1 '(a b c)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (equalt s1 s2))) + t) + +(deftest copy-seq.3 + (let* ((s1 #(a b c)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) s2)) + #(a b c)) + +(deftest copy-seq.4 + (let* ((s1 (make-array '(4) :initial-contents '(a b c d) + :adjustable t)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-vector-p s2) + s2)) + #(a b c d)) + + +(deftest copy-seq.5 + (let* ((s1 (make-array '(4) :initial-contents '(a b c d) + :fill-pointer 3)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-vector-p s2) + s2)) + #(a b c)) + +(deftest copy-seq.6 + (let* ((a1 (make-array '(6) :initial-contents '(a b c d e f))) + (a2 (make-array '(4) :displaced-to a1 + :displaced-index-offset 1)) + (s2 (copy-seq a2))) + (and (not (eql a2 s2)) + (simple-vector-p s2) + s2)) + #(b c d e)) + +(deftest copy-seq.7 + (let* ((s1 (make-array '(4) + :element-type 'base-char + :initial-contents '(#\a #\b #\c #\d) + :adjustable t)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-string-p s2) + s2)) + "abcd") + + +(deftest copy-seq.8 + (let* ((s1 (make-array '(4) + :element-type 'base-char + :initial-contents '(#\a #\b #\c #\d) + :fill-pointer 3)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-string-p s2) + s2)) + "abc") + +(deftest copy-seq.9 + (let* ((a1 (make-array '(6) :initial-contents '(#\a #\b #\c #\d #\e #\f) + :element-type 'base-char)) + (a2 (make-array '(4) :displaced-to a1 + :element-type 'base-char + :displaced-index-offset 1)) + (s2 (copy-seq a2))) + (and (not (eql a2 s2)) + (simple-string-p s2) + s2)) + "bcde") + +(deftest copy-seq.10 + (let*((s1 "abcd") + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + s2)) + "abcd") + +(deftest copy-seq.11 + (let* ((s1 #*0010110) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-bit-vector-p s2) + s2)) + #*0010110) + +(deftest copy-seq.12 + (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0) + :element-type 'bit + :adjustable t)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-bit-vector-p s2) + s2)) + #*0010) + +(deftest copy-seq.13 + (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0) + :element-type 'bit + :fill-pointer 3)) + (s2 (copy-seq s1))) + (and (not (eql s1 s2)) + (simple-bit-vector-p s2) + s2)) + #*001) + +(deftest copy-seq.14 + (let* ((a1 (make-array '(6) :initial-contents '(0 0 1 0 1 1) + :element-type 'bit)) + (a2 (make-array '(4) :displaced-to a1 + :displaced-index-offset 1 + :element-type 'bit)) + (s2 (copy-seq a2))) + (and (not (eql a2 s2)) + (simple-bit-vector-p s2) + s2)) + #*0101) + +(deftest copy-seq.15 + (copy-seq "") + "") + +(deftest copy-seq.16 + (copy-seq #*) + #*) + +(deftest copy-seq.17 + (copy-seq #()) + #()) + +;;; Error tests + +(deftest copy-seq.error.1 + (classify-error (copy-seq 10)) + type-error) + +(deftest copy-seq.error.2 + (classify-error (copy-seq 'a)) + type-error) + +(deftest copy-seq.error.3 + (classify-error (copy-seq 13.21)) + type-error) diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp index ac30142b6f0363231510b0498a2375667404c522..04443c813439c86a1b10312cb4dcc651f50b216b 100644 --- a/ansi-tests/elt.lsp +++ b/ansi-tests/elt.lsp @@ -276,3 +276,70 @@ (deftest elt-displaced-array-3 (elt (make-displaced-array '(5) 100) 4) 104) + +;;; Arrays with fill points + +(deftest elt-fill-pointer-1 + (let ((a (make-array '(5) :initial-contents '(a b c d e) + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + a b c) + +(deftest elt-fill-pointer-2 + (let ((a (make-array '(5) + :initial-contents '(0 0 1 0 0) + :element-type 'bit + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + 0 0 1) + +(deftest elt-fill-pointer-3 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(0 0 1 0 0) + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt-fill-pointer-4 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(0 0 1 0 0) + :element-type 'bit + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt-fill-pointer-5 + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'character + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + #\a #\b #\c) + +(deftest elt-fill-pointer-6 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'character + :fill-pointer 3))) + (elt a 4))) + type-error) + +(deftest elt-fill-pointer-7 + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'base-char + :fill-pointer 3))) + (values (elt a 0) (elt a 1) (elt a 2))) + #\a #\b #\c) + +(deftest elt-fill-pointer-8 + (classify-error + (let ((a (make-array '(5) + :initial-contents '(#\a #\b #\c #\d #\e) + :element-type 'base-char + :fill-pointer 3))) + (elt a 4))) + type-error) diff --git a/ansi-tests/fill.lsp b/ansi-tests/fill.lsp index eb4812524de65c38d69fc2e7c32c08ec9bdc250a..8266655ff6ad3b51ed8c96479010675e5c7d82a0 100644 --- a/ansi-tests/fill.lsp +++ b/ansi-tests/fill.lsp @@ -194,4 +194,53 @@ (classify-error (array-unsigned-byte-fill-test-fn 8 17 :end 'a)) type-error) +;;; Tests on arrays with fill pointers +(deftest array-fill-pointer-fill.1 + (let ((s1 (make-array '(10) :fill-pointer 5 :initial-element nil))) + (fill s1 'a) + (loop for i from 0 to 9 collect (aref s1 i))) + (a a a a a nil nil nil nil nil)) + +(deftest array-fill-pointer-fill.2 + (let ((s1 (make-array '(10) :fill-pointer 5 :initial-element nil))) + (fill s1 'a :end nil) + (loop for i from 0 to 9 collect (aref s1 i))) + (a a a a a nil nil nil nil nil)) + +;;; Tests on strings + +(deftest fill.string.1 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z))) + (values (eqt s1 s2) s2)) + t + "zzzzz") + +(deftest fill.string.2 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z :start 0 :end 1))) + (values (eqt s1 s2) s2)) + t + "zbcde") + +(deftest fill.string.3 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z :end 2))) + (values (eqt s1 s2) s2)) + t + "zzcde") + +(deftest fill.string.4 + (let* ((s1 (copy-seq "abcde")) + (s2 (fill s1 #\z :end nil))) + (values (eqt s1 s2) s2)) + t + "zzzzz") + + + + + + + diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 7f66edca313a7fd1e1941e70b3c54c20667d5840..ce4a33f253d0736c848df9690f22bfc35004f106 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -78,6 +78,7 @@ (load "loop2.lsp") (load "loop3.lsp") (load "loop4.lsp") +(load "loop5.lsp") ;;; Tests of conses @@ -113,7 +114,7 @@ ;;; Tests of sequences -;;; (load "copy-seq.lsp") +(load "copy-seq.lsp") (load "elt.lsp") (load "fill.lsp") (load "fill-strings.lsp") diff --git a/ansi-tests/loop4.lsp b/ansi-tests/loop4.lsp index e29da999fd5b23b2094814f3a669421d237d33ea..bd0f7e1b05653d90960f95d946450a93e8094b4a 100644 --- a/ansi-tests/loop4.lsp +++ b/ansi-tests/loop4.lsp @@ -18,4 +18,40 @@ for j = (1+ i) collect j) (2 3 4 5 6 7 8 9 10 11)) +(deftest loop.4.3 + (loop + for i from 1 to 10 + for j of-type integer = (1+ i) collect j) + (2 3 4 5 6 7 8 9 10 11)) + +(deftest loop.4.4 + (loop for e on '(a b c d e) + for (x . y) = e + collect x) + (a b c d e)) + +(deftest loop.4.5 + (loop for (x . y) = '(a b c d e) then y + while x + collect x) + (a b c d e)) + +;;; Error cases + +(deftest loop.4.6 + (classify-error + (loop for (x . x) = '(nil nil nil) + until x count t)) + program-error) + +(deftest loop.4.7 + (classify-error* + (macroexpand '(loop for (x . x) = '(nil nil nil) + until x count t))) + program-error) +(deftest loop.4.8 + (classify-error* + (macroexpand '(loop for x = '(nil nil nil) + for x = 1 count x until t))) + program-error) diff --git a/ansi-tests/loop5.lsp b/ansi-tests/loop5.lsp new file mode 100644 index 0000000000000000000000000000000000000000..5c2f4e052915973be1848e376c910fbe080c91df --- /dev/null +++ b/ansi-tests/loop5.lsp @@ -0,0 +1,137 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Nov 2 13:52:50 2002 +;;;; Contains: Tests of LOOP clause FOR-AS-ACROSS + +(in-package :cl-test) + +(deftest loop.5.1 + (let ((x "abcd")) (loop for e across x collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.2 + (let ((x "abcd")) (loop for e across (the string x) collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.3 + (let ((x "abcd")) (loop for e across (the simple-string x) collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.4 + (loop for e across "abcd" collect e) + (#\a #\b #\c #\d)) + +(deftest loop.5.5 + (loop for e across "abcd" + for i from 1 to 3 collect e) + (#\a #\b #\c)) + +(deftest loop.5.6 + (loop for e of-type base-char across "abcd" + for i from 1 to 3 collect e) + (#\a #\b #\c)) + +(deftest loop.5.7 + (let ((x "abcd")) (loop for e across (the base-string x) collect e)) + (#\a #\b #\c #\d)) + +(deftest loop.5.8 + (let ((x "abcd")) (loop for e of-type character across x collect e)) + (#\a #\b #\c #\d)) + + +(deftest loop.5.10 + (let ((x #*00010110)) + (loop for e across x collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.11 + (let ((x #*00010110)) + (loop for e across (the bit-vector x) collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.12 + (let ((x #*00010110)) + (loop for e across (the simple-bit-vector x) collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.13 + (let ((x #*00010110)) + (loop for e of-type bit across (the simple-bit-vector x) collect e)) + (0 0 0 1 0 1 1 0)) + +(deftest loop.5.14 + (let ((x #*00010110)) + (loop for e of-type bit across x + for i from 1 to 4 collect e)) + (0 0 0 1)) + + +(deftest loop.5.20 + (let ((x (vector 'a 'b 'c 'd))) + (loop for e across x collect e)) + (a b c d)) + +(deftest loop.5.21 + (let ((x (vector 'a 'b 'c 'd))) + (loop for e across (the vector x) collect e)) + (a b c d)) + +(deftest loop.5.22 + (let ((x (vector 'a 'b 'c 'd))) + (loop for e across (the simple-vector x) collect e)) + (a b c d)) + +(deftest loop.5.23 + (let ((x (vector '(a) '(b) '(c) '(d)))) + (loop for (e) across x collect e)) + (a b c d)) + + +(deftest loop.5.30 + (let ((x (make-array '(5) :initial-contents '(a b c d e) + :adjustable t))) + (loop for e across x collect e)) + (a b c d e)) + +(deftest loop.5.32 + (let* ((x (make-array '(5) :initial-contents '(a b c d e))) + (y (make-array '(3) :displaced-to x + :displaced-index-offset 1))) + (loop for e across y collect e)) + (b c d)) + + + + +;;; Error cases + +(deftest loop.5.error.1 + (classify-error + (loop for (e . e) across (vector '(x . y) '(u . v)) collect e)) + program-error) + +(deftest loop.5.error.2 + (classify-error + (loop for e across (vector '(x . y) '(u . v)) + for e from 1 to 5 collect e)) + program-error) + +(deftest loop.5.error.3 + (classify-error* + (macroexpand + '(loop for (e . e) across (vector '(x . y) '(u . v)) collect e))) + program-error) + +(deftest loop.5.error.4 + (classify-error* + (macroexpand + '(loop for e across (vector '(x . y) '(u . v)) + for e from 1 to 5 collect e))) + program-error) + + + + + +