diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index 2d87448cca2efa82118249163c605e9814af1762..2911e2794703af4333344c83257be61e4d9a53d7 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -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) + diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp index e1360c871b1d2ed14bd27cf95f892ed64d3fe621..803e303e2dadcee14442009e527dd764c74ea63b 100644 --- a/ansi-tests/find.lsp +++ b/ansi-tests/find.lsp @@ -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 diff --git a/ansi-tests/length.lsp b/ansi-tests/length.lsp index 0980e390cf89045288c42853a25521cf3420d3d5..6b2045378b3b003d06baf8f1b03c6c0d2fe7086a 100644 Binary files a/ansi-tests/length.lsp and b/ansi-tests/length.lsp differ diff --git a/ansi-tests/nreverse.lsp b/ansi-tests/nreverse.lsp index 9845aed43dc7178d18874bf7a2f1d0b4e05b5a5f..f8246525e810c5772efb05a95dfdf66d60a093e9 100644 --- a/ansi-tests/nreverse.lsp +++ b/ansi-tests/nreverse.lsp @@ -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) diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp index 7fc4ef9ad994aa52651eea8d9b54af18b7ecf70c..fa84ea8e137e93a242025fbf7fe33f6b38695294 100644 --- a/ansi-tests/reverse.lsp +++ b/ansi-tests/reverse.lsp @@ -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 diff --git a/ansi-tests/sort.lsp b/ansi-tests/sort.lsp index f1acc25a5af4a24d79f6c0f045e0351597424f97..4cf39828253110786442b0e3645a044363972738 100644 --- a/ansi-tests/sort.lsp +++ b/ansi-tests/sort.lsp @@ -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))) diff --git a/ansi-tests/stable-sort.lsp b/ansi-tests/stable-sort.lsp index cefd4fe2db9c0a105579db5a0ea6af7b66d6ff84..ea0443d1c3fc44d54a6a71bf8a78c09736b12ba2 100644 --- a/ansi-tests/stable-sort.lsp +++ b/ansi-tests/stable-sort.lsp @@ -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 #'<))