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