From b30255e2af037733f3a0d8db59bd591414cfacf0 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 27 Sep 2004 13:54:20 +0000 Subject: [PATCH] More unusual result-type tests, this time for CONCATENATE. Specialized vector tests for length, reverse, nreverse, sort, stable-sort, and find. --- ansi-tests/concatenate.lsp | 79 ++++++++++++++++++++++++++++++++++--- ansi-tests/find.lsp | 23 +++++++++++ ansi-tests/length.lsp | Bin 3296 -> 4162 bytes ansi-tests/nreverse.lsp | 57 ++++++++++++++++++++++++-- ansi-tests/reverse.lsp | 64 ++++++++++++++++++++++++++++-- ansi-tests/sort.lsp | 56 +++++++++++++++++++++++++- ansi-tests/stable-sort.lsp | 56 ++++++++++++++++++++++++++ 7 files changed, 323 insertions(+), 12 deletions(-) diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index 2d87448c..2911e279 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 e1360c87..803e303e 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 GIT binary patch delta 794 zcmb7?&q@O^5XLV>?5YRpK|BZp9!$W6U8=2Ge1l%Sis|lj8%&d$WD7m@6@+~eUqPRw zFCsYU*5V(8^%OE+GBe-IZ*}|zFRT4dG#CuvPM59}3g(!3W2@KQPW8OEv+P9xOc^tS zv9TawY|Ru>@CGiDs2yVH7c+!gcwnV=ve1~vqlHH}m%M&J8A)bS@rbdoRxF?oH>hxm z+Q;k9b&4CQrI$j*8x0a34c8?U>X3ns!cRhnl)2OjodbqX3WDCJSZ0)>_UWZ`o|+An zN#mSMXsN2hR&A>P4^s^-rQOD!+QTrmCZ5u6b5r+M-%Qmbl^V{Nn;7fku`<Ggle$p2 zx#XrCZ7<5`ViUK*OQVJQy1(kZb+Y_pPb@QNGlZmOfyUi<YnQ(a)-`@?jz<y8u{vrU z1SrLIu$r6L%`gkVNbRve8`Cdh*O3Zr4yP<3Qd4S+P96XV8~_u}p(RKHIa{VU^!O(y GJo*4){rbEB delta 7 OcmX@4@IZ3I10DblwF7tn diff --git a/ansi-tests/nreverse.lsp b/ansi-tests/nreverse.lsp index 9845aed4..f8246525 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 7fc4ef9a..fa84ea8e 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 f1acc25a..4cf39828 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 cefd4fe2..ea0443d1 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 #'<)) -- GitLab