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 @@ ...@@ -89,6 +89,22 @@
(concatenate '(vector * *) '(a b c) '(d e f) #(g h)) (concatenate '(vector * *) '(a b c) '(d e f) #(g h))
#(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 (deftest concatenate.19
(concatenate '(vector * 8) '(a b c) '(d e f) #(g h)) (concatenate '(vector * 8) '(a b c) '(d e f) #(g h))
#(a b c d e f g h)) #(a b c d e f g h))
...@@ -173,9 +189,25 @@ ...@@ -173,9 +189,25 @@
:fill-pointer 5 :element-type 'bit))) :fill-pointer 5 :element-type 'bit)))
(values (values
(concatenate 'bit-vector x '(0)) (concatenate 'bit-vector x '(0))
(concatenate 'bit-vector '(0) x) (concatenate '(bit-vector) '(0) x)
(concatenate 'bit-vector x x) (concatenate '(bit-vector 10) x x)
(concatenate 'bit-vector 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))) (not (simple-bit-vector-p (concatenate 'bit-vector x)))
)) ))
#*011000 #*011000
...@@ -204,6 +236,36 @@ ...@@ -204,6 +236,36 @@
(assert (string= (concatenate 'simple-base-string s "z" s "w" s) "abczabcwabc")) (assert (string= (concatenate 'simple-base-string s "z" s "w" s) "abczabcwabc"))
(assert (string= (concatenate '(vector character) s "z" s "w" s) "abczabcwabc"))) (assert (string= (concatenate '(vector character) s "z" s "w" s) "abczabcwabc")))
nil) 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 (deftest concatenate.order.1
(let ((i 0) w x y z) (let ((i 0) w x y z)
...@@ -232,8 +294,8 @@ ...@@ -232,8 +294,8 @@
t) t)
(deftest concatenate.error.2 (deftest concatenate.error.2
(signals-error (concatenate 'fixnum '(a b c d e)) error) (signals-error-always (concatenate 'fixnum '(a b c d e)) error)
t) t t)
(deftest concatenate.error.3 (deftest concatenate.error.3
(signals-error (concatenate '(vector * 3) '(a b c d e)) (signals-error (concatenate '(vector * 3) '(a b c d e))
...@@ -249,3 +311,10 @@ ...@@ -249,3 +311,10 @@
type-error) type-error)
t) 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 @@ ...@@ -336,6 +336,29 @@
(find 10 #(1 2 3 8 20 3 1 21 3) :test-not #'>=) (find 10 #(1 2 3 8 20 3 1 21 3) :test-not #'>=)
20) 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 ;;; tests on bit vectors
(deftest find-bit-vector.1 (deftest find-bit-vector.1
......
No preview for this file type
...@@ -23,12 +23,12 @@ ...@@ -23,12 +23,12 @@
(nreverse x)) (nreverse x))
#(e d c b a)) #(e d c b a))
(deftest nreverse-nonsimple-vector.1 (deftest nreverse-vector.4
(let ((x (make-array 0 :fill-pointer t :adjustable t))) (let ((x (make-array 0 :fill-pointer t :adjustable t)))
(nreverse x)) (nreverse x))
#()) #())
(deftest nreverse-nonsimple-vector.2 (deftest nreverse-vector.5
(let* ((x (make-array 5 :initial-contents '(1 2 3 4 5) (let* ((x (make-array 5 :initial-contents '(1 2 3 4 5)
:fill-pointer t :adjustable t)) :fill-pointer t :adjustable t))
(y (nreverse x))) (y (nreverse x)))
...@@ -36,7 +36,7 @@ ...@@ -36,7 +36,7 @@
#(5 4 3 2 1) #(5 4 3 2 1)
t) 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) (let* ((x (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 5)) :fill-pointer 5))
(y (nreverse x))) (y (nreverse x)))
...@@ -44,6 +44,51 @@ ...@@ -44,6 +44,51 @@
#(5 4 3 2 1) #(5 4 3 2 1)
t) 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 (deftest nreverse-bit-vector.1
(nreverse #*) (nreverse #*)
#*) #*)
...@@ -61,6 +106,8 @@ ...@@ -61,6 +106,8 @@
y) y)
#*11000) #*11000)
;;; Strings
(deftest nreverse-string.1 (deftest nreverse-string.1
(nreverse "") (nreverse "")
"") "")
...@@ -95,6 +142,8 @@ ...@@ -95,6 +142,8 @@
(assert (equal (array-element-type s) (array-element-type s2))))) (assert (equal (array-element-type s) (array-element-type s2)))))
nil) nil)
;;; Argument is evaluated only once
(deftest nreverse.order.1 (deftest nreverse.order.1
(let ((i 0)) (let ((i 0))
(values (values
...@@ -102,6 +151,8 @@ ...@@ -102,6 +151,8 @@
i)) i))
(d c b a) 1) (d c b a) 1)
;;; Error tests
(deftest nreverse.error.1 (deftest nreverse.error.1
(signals-error (nreverse 'a) type-error) (signals-error (nreverse 'a) type-error)
t) t)
......
...@@ -25,12 +25,12 @@ ...@@ -25,12 +25,12 @@
#(e d c b a) #(e d c b a)
#(a b c d e)) #(a b c d e))
(deftest reverse-nonsimple-vector.1 (deftest reverse-vector.3
(let ((x (make-array 0 :fill-pointer t :adjustable t))) (let ((x (make-array 0 :fill-pointer t :adjustable t)))
(reverse x)) (reverse x))
#()) #())
(deftest reverse-nonsimple-vector.2 (deftest reverse-vector.4
(let* ((x (make-array 5 :initial-contents '(1 2 3 4 5) (let* ((x (make-array 5 :initial-contents '(1 2 3 4 5)
:fill-pointer t :adjustable t)) :fill-pointer t :adjustable t))
(y (reverse x))) (y (reverse x)))
...@@ -38,13 +38,67 @@ ...@@ -38,13 +38,67 @@
#(5 4 3 2 1) #(5 4 3 2 1)
#(1 2 3 4 5)) #(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) (let* ((x (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 5)) :fill-pointer 5))
(y (reverse x))) (y (reverse x)))
y) y)
#(5 4 3 2 1)) #(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 (deftest reverse-bit-vector.1
(reverse #*) (reverse #*)
#*) #*)
...@@ -63,6 +117,8 @@ ...@@ -63,6 +117,8 @@
y) y)
#*11000) #*11000)
;;; Strings
(deftest reverse-string.1 (deftest reverse-string.1
(reverse "") (reverse "")
"") "")
...@@ -101,6 +157,8 @@ ...@@ -101,6 +157,8 @@
(assert (string= "54321" s2)))) (assert (string= "54321" s2))))
nil) nil)
;;; Order, number of times of evaluation
(deftest reverse.order.1 (deftest reverse.order.1
(let ((i 0)) (let ((i 0))
(values (values
......
...@@ -73,7 +73,61 @@ ...@@ -73,7 +73,61 @@
(setq a (sort a #'(lambda (i j) (aref cmp i j)))) (setq a (sort a #'(lambda (i j) (aref cmp i j))))
(and (eqlt (length a) 10) (and (eqlt (length a) 10)
(equalpt (sort a #'<) #(0 1 2 3 4 5 6 7 8 9))))) (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 (deftest sort-bit-vector.1
(let ((a (copy-seq #*10011101))) (let ((a (copy-seq #*10011101)))
......
...@@ -53,6 +53,62 @@ ...@@ -53,6 +53,62 @@
(stable-sort a #'<)) (stable-sort a #'<))
#(10 20 30 40 50)) #(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 (deftest stable-sort-bit-vector.1
(let ((a (copy-seq #*10011101))) (let ((a (copy-seq #*10011101)))
(stable-sort a #'<)) (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