Commit b30255e2 authored by pfdietz's avatar pfdietz

More unusual result-type tests, this time for CONCATENATE. Specialized vector...

More unusual result-type tests, this time for CONCATENATE.  Specialized vector tests for length, reverse, nreverse, sort, stable-sort, and find.
parent 0ea48261
......@@ -89,6 +89,22 @@
(concatenate '(vector * *) '(a b c) '(d e f) #(g h))
#(a b c d e f g h))
(deftest concatenate.18a
(concatenate '(vector *) '(a b c) '(d e f) #(g h))
#(a b c d e f g h))
(deftest concatenate.18b
(concatenate '(vector) '(a b c) '(d e f) #(g h))
#(a b c d e f g h))
(deftest concatenate.18c
(concatenate '(simple-vector *) '(a b c) '(d e f) #(g h))
#(a b c d e f g h))
(deftest concatenate.18d
(concatenate '(simple-vector) '(a b c) '(d e f) #(g h))
#(a b c d e f g h))
(deftest concatenate.19
(concatenate '(vector * 8) '(a b c) '(d e f) #(g h))
#(a b c d e f g h))
......@@ -173,9 +189,25 @@
:fill-pointer 5 :element-type 'bit)))
(values
(concatenate 'bit-vector x '(0))
(concatenate 'bit-vector '(0) x)
(concatenate 'bit-vector x x)
(concatenate 'bit-vector x)
(concatenate '(bit-vector) '(0) x)
(concatenate '(bit-vector 10) x x)
(concatenate '(bit-vector *) x)
(not (simple-bit-vector-p (concatenate 'bit-vector x)))
))
#*011000
#*001100
#*0110001100
#*01100
nil)
(deftest concatenate.30a
(let* ((x (make-array '(10) :initial-contents #*0110010111
:fill-pointer 5 :element-type 'bit)))
(values
(concatenate 'simple-bit-vector x '(0))
(concatenate 'simple-bit-vector '(0) x)
(concatenate 'simple-bit-vector x x)
(concatenate 'simple-bit-vector x)
(not (simple-bit-vector-p (concatenate 'bit-vector x)))
))
#*011000
......@@ -204,6 +236,36 @@
(assert (string= (concatenate 'simple-base-string s "z" s "w" s) "abczabcwabc"))
(assert (string= (concatenate '(vector character) s "z" s "w" s) "abczabcwabc")))
nil)
(deftest concatenate.34
(concatenate 'simple-string "abc" "def")
"abcdef")
(deftest concatenate.35
(concatenate '(simple-string) "abc" "def")
"abcdef")
(deftest concatenate.36
(concatenate '(simple-string *) "abc" "def")
"abcdef")
(deftest concatenate.37
(concatenate '(simple-string 6) "abc" "def")
"abcdef")
(deftest concatenate.38
(concatenate '(string) "abc" "def")
"abcdef")
(deftest concatenate.39
(concatenate '(string *) "abc" "def")
"abcdef")
(deftest concatenate.40
(concatenate '(string 6) "abc" "def")
"abcdef")
;;; Order of evaluation tests
(deftest concatenate.order.1
(let ((i 0) w x y z)
......@@ -232,8 +294,8 @@
t)
(deftest concatenate.error.2
(signals-error (concatenate 'fixnum '(a b c d e)) error)
t)
(signals-error-always (concatenate 'fixnum '(a b c d e)) error)
t t)
(deftest concatenate.error.3
(signals-error (concatenate '(vector * 3) '(a b c d e))
......@@ -249,3 +311,10 @@
type-error)
t)
(deftest concatenate.error.6
(let ((type '(or (vector bit) (vector t))))
(if (subtypep type 'vector)
(eval `(signals-error-always (concatenate ',type '(0 1 0) '(1 1 0)) error))
(values t t)))
t t)
......@@ -336,6 +336,29 @@
(find 10 #(1 2 3 8 20 3 1 21 3) :test-not #'>=)
20)
(deftest find-vector.33
(do-special-integer-vectors
(v #(1 2 3 4 5 6 7) nil)
(assert (null (find 0 v)))
(assert (= (find 4 v) 4))
(assert (= (find -1 v :test #'<) 1))
(assert (= (find -1 v :test #'< :from-end t) 7)))
nil)
(deftest find-vector.34
(do-special-integer-vectors
(v #(0 0 0 0) nil)
(assert (eql (find 0 v) 0))
(assert (eql (find 0 v :start 1) 0))
(assert (eql (find 0 v :from-end t) 0))
(assert (null (find 1 v)))
(assert (null (find 'a v)))
(assert (null (find 0.0 v)))
(assert (null (find #c(1.0 0.0) v)))
(assert (null (find -1 v)))
(assert (null (find 2 v))))
nil)
;;; tests on bit vectors
(deftest find-bit-vector.1
......
No preview for this file type
......@@ -23,12 +23,12 @@
(nreverse x))
#(e d c b a))
(deftest nreverse-nonsimple-vector.1
(deftest nreverse-vector.4
(let ((x (make-array 0 :fill-pointer t :adjustable t)))
(nreverse x))
#())
(deftest nreverse-nonsimple-vector.2
(deftest nreverse-vector.5
(let* ((x (make-array 5 :initial-contents '(1 2 3 4 5)
:fill-pointer t :adjustable t))
(y (nreverse x)))
......@@ -36,7 +36,7 @@
#(5 4 3 2 1)
t)
(deftest nreverse-nonsimple-vector.3
(deftest nreverse-vector.6
(let* ((x (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 5))
(y (nreverse x)))
......@@ -44,6 +44,51 @@
#(5 4 3 2 1)
t)
;;; Unusual vectors
(deftest nreverse-vector.7
(do-special-integer-vectors
(v #(0 0 1 0 1 1) nil)
(let ((nv (nreverse v)))
(assert (= (length nv) 6))
(assert (every #'= nv #(1 1 0 1 0 0)))))
nil)
(deftest nreverse-vector.8
(do-special-integer-vectors
(v #(0 0 -1 0 -1 -1 0 -1) nil)
(let ((nv (nreverse v)))
(assert (= (length nv) 8))
(assert (every #'= nv #(-1 0 -1 -1 0 -1 0 0)))))
nil)
(deftest nreverse-vector.9
(let ((len 10))
(loop for etype in '(short-float single-float double-float long-float rational)
for vals = (loop for i from 1 to len collect (coerce i etype))
for vec = (make-array len :element-type etype :initial-contents vals)
for nvec = (nreverse vec)
unless (and (eql (length nvec) len)
(every #'eql (reverse vals) nvec))
collect (list etype vals nvec)))
nil)
(deftest nreverse-vector.10
(let ((len 10))
(loop for cetype in '(short-float single-float double-float long-float rational integer)
for etype = `(complex ,cetype)
for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for vec = (make-array len :element-type etype :initial-contents vals)
for nvec = (nreverse vec)
unless (and (eql (length nvec) len)
(every #'eql (reverse vals) nvec))
collect (list etype vals nvec)))
nil)
;;; Bit vectors
(deftest nreverse-bit-vector.1
(nreverse #*)
#*)
......@@ -61,6 +106,8 @@
y)
#*11000)
;;; Strings
(deftest nreverse-string.1
(nreverse "")
"")
......@@ -95,6 +142,8 @@
(assert (equal (array-element-type s) (array-element-type s2)))))
nil)
;;; Argument is evaluated only once
(deftest nreverse.order.1
(let ((i 0))
(values
......@@ -102,6 +151,8 @@
i))
(d c b a) 1)
;;; Error tests
(deftest nreverse.error.1
(signals-error (nreverse 'a) type-error)
t)
......
......@@ -25,12 +25,12 @@
#(e d c b a)
#(a b c d e))
(deftest reverse-nonsimple-vector.1
(deftest reverse-vector.3
(let ((x (make-array 0 :fill-pointer t :adjustable t)))
(reverse x))
#())
(deftest reverse-nonsimple-vector.2
(deftest reverse-vector.4
(let* ((x (make-array 5 :initial-contents '(1 2 3 4 5)
:fill-pointer t :adjustable t))
(y (reverse x)))
......@@ -38,13 +38,67 @@
#(5 4 3 2 1)
#(1 2 3 4 5))
(deftest reverse-nonsimple-vector.3
(deftest reverse-vector.5
(let* ((x (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 5))
(y (reverse x)))
y)
#(5 4 3 2 1))
;;; Other unusual vectors
(deftest reverse-vector.6
(do-special-integer-vectors
(v #(1 1 0 1 1 0) nil)
(let ((nv (reverse v)))
(assert (typep nv 'simple-array))
(assert (not (eql v nv)))
(assert (equalp nv #(0 1 1 0 1 1)))
(assert (equalp v #(1 1 0 1 1 0)))))
nil)
(deftest reverse-vector.7
(do-special-integer-vectors
(v #(-1 -1 0 -1 -1 0) nil)
(let ((nv (reverse v)))
(assert (typep nv 'simple-array))
(assert (not (eql v nv)))
(assert (equalp nv #(0 -1 -1 0 -1 -1)))
(assert (equalp v #(-1 -1 0 -1 -1 0)))))
nil)
(deftest reverse-vector.8
(let ((len 10))
(loop for etype in '(short-float single-float double-float long-float rational)
for vals = (loop for i from 1 to len collect (coerce i etype))
for vec = (make-array len :element-type etype :initial-contents vals)
for nvec = (reverse vec)
unless (and (eql (length nvec) len)
(typep nvec 'simple-array)
(not (eql vec nvec))
(every #'eql (reverse vals) nvec)
(every #'eql vals vec))
collect (list etype vals vec nvec)))
nil)
(deftest reverse-vector.9
(let ((len 10))
(loop for cetype in '(short-float single-float double-float long-float rational integer)
for etype = `(complex ,cetype)
for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for vec = (make-array len :element-type etype :initial-contents vals)
for nvec = (reverse vec)
unless (and (eql (length nvec) len)
(typep nvec 'simple-array)
(not (eql vec nvec))
(every #'eql (reverse vals) nvec)
(every #'eql vals vec))
collect (list etype vals vec nvec)))
nil)
;;; Bit vectors
(deftest reverse-bit-vector.1
(reverse #*)
#*)
......@@ -63,6 +117,8 @@
y)
#*11000)
;;; Strings
(deftest reverse-string.1
(reverse "")
"")
......@@ -101,6 +157,8 @@
(assert (string= "54321" s2))))
nil)
;;; Order, number of times of evaluation
(deftest reverse.order.1
(let ((i 0))
(values
......
......@@ -73,7 +73,61 @@
(setq a (sort a #'(lambda (i j) (aref cmp i j))))
(and (eqlt (length a) 10)
(equalpt (sort a #'<) #(0 1 2 3 4 5 6 7 8 9)))))
t)
t)
(deftest sort-vector.6
(do-special-integer-vectors
(v #(1 4 7 3 2 6 5) nil)
(let ((sv (sort v #'<)))
(assert (equalp sv #(1 2 3 4 5 6 7)))))
nil)
(deftest sort-vector.7
(do-special-integer-vectors
(v #(0 1 1 0 1 1 0 1 0) nil)
(let ((sv (sort v #'<)))
(assert (equalp sv #(0 0 0 0 1 1 1 1 1)))))
nil)
(deftest sort-vector.8
(do-special-integer-vectors
(v #(0 -1 -1 0 -1 -1 0 -1 0) nil)
(let ((sv (sort v #'>)))
(assert (equalp sv #(0 0 0 0 -1 -1 -1 -1 -1)))))
nil)
(deftest sort-vector.9
(let* ((ivals '(1 4 7 3 2 6 5))
(sivals '(1 2 3 4 5 6 7))
(len (length ivals)))
(loop for etype in '(short-float single-float double-float long-float rational)
for vals = (loop for i in ivals collect (coerce i etype))
for svals = (loop for i in sivals collect (coerce i etype))
for vec = (make-array len :element-type etype :initial-contents vals)
for svec = (sort vec #'<)
unless (and (eql (length svec) len)
(every #'eql svals svec))
collect (list etype vals svec)))
nil)
(deftest sort-vector.10
(let* ((ivals '(1 4 7 3 2 6 5))
(sivals '(1 2 3 4 5 6 7))
(len (length ivals)))
(loop for cetype in '(short-float single-float double-float long-float rational)
for etype = `(complex ,cetype)
for vals = (loop for i in ivals collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for svals = (loop for i in sivals collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for vec = (make-array len :element-type etype :initial-contents vals)
for svec = (sort vec #'(lambda (x y) (< (abs x) (abs y))))
unless (and (eql (length svec) len)
(every #'eql svals svec))
collect (list etype vals svec)))
nil)
;;; Bit vectors
(deftest sort-bit-vector.1
(let ((a (copy-seq #*10011101)))
......
......@@ -53,6 +53,62 @@
(stable-sort a #'<))
#(10 20 30 40 50))
;;; FIXME Add random test similar to sort.5 here
(deftest stable-sort-vector.6
(do-special-integer-vectors
(v #(1 4 7 3 2 6 5) nil)
(let ((sv (stable-sort v #'<)))
(assert (equalp sv #(1 2 3 4 5 6 7)))))
nil)
(deftest stable-sort-vector.7
(do-special-integer-vectors
(v #(0 1 1 0 1 1 0 1 0) nil)
(let ((sv (stable-sort v #'<)))
(assert (equalp sv #(0 0 0 0 1 1 1 1 1)))))
nil)
(deftest stable-sort-vector.8
(do-special-integer-vectors
(v #(0 -1 -1 0 -1 -1 0 -1 0) nil)
(let ((sv (stable-sort v #'>)))
(assert (equalp sv #(0 0 0 0 -1 -1 -1 -1 -1)))))
nil)
(deftest stable-sort-vector.9
(let* ((ivals '(1 4 7 3 2 6 5))
(sivals '(1 2 3 4 5 6 7))
(len (length ivals)))
(loop for etype in '(short-float single-float double-float long-float rational)
for vals = (loop for i in ivals collect (coerce i etype))
for svals = (loop for i in sivals collect (coerce i etype))
for vec = (make-array len :element-type etype :initial-contents vals)
for svec = (stable-sort vec #'<)
unless (and (eql (length svec) len)
(every #'eql svals svec))
collect (list etype vals svec)))
nil)
(deftest stable-sort-vector.10
(let* ((ivals '(1 4 7 3 2 6 5))
(sivals '(1 2 3 4 5 6 7))
(len (length ivals)))
(loop for cetype in '(short-float single-float double-float long-float rational)
for etype = `(complex ,cetype)
for vals = (loop for i in ivals collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for svals = (loop for i in sivals collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for vec = (make-array len :element-type etype :initial-contents vals)
for svec = (stable-sort vec #'(lambda (x y) (< (abs x) (abs y))))
unless (and (eql (length svec) len)
(every #'eql svals svec))
collect (list etype vals svec)))
nil)
;;; Bit vectors
(deftest stable-sort-bit-vector.1
(let ((a (copy-seq #*10011101)))
(stable-sort a #'<))
......
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