Commit 783a166b authored by pfdietz's avatar pfdietz

Added tests for FOR-AS-ACROSS; added other loops tests; add more tests for...

Added tests for FOR-AS-ACROSS; added other loops tests; add more tests for COPY-SEQ; added tests to show that ELT and FILL respect fill pointers.
parent 8dab13e8
;-*- 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)
......@@ -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)
......@@ -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")
......@@ -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")
......
......@@ -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)
;-*- 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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment