From 77869604fc3eb4417a630651e5fe40e74342ee59 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Sat, 14 Jun 2003 13:39:30 +0000
Subject: [PATCH] 0.8.0.70: 	A couple of fixes: 	... SEARCH and test
 predicate argument ordering: patch from 	
 Wolfhard Buss cmucl-imp 2003-06-13 	...
 VECTOR-PUSH-EXTEND and type inference: disable MAKE-ARRAY 
 	dimension type inferencing for non-simple 1d arrays,
 as 		the dimension can change too easily. 
 Regressions noted 		by pfdietz' test suite.

---
 NEWS                         |    2 ++
 src/code/seq.lisp            |    8 ++++----
 src/compiler/array-tran.lisp |    7 +++++--
 tests/vector.pure.lisp       |   12 ++++++++++++
 version.lisp-expr            |    2 +-
 5 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index 6617ba6..cda9759 100644
--- a/NEWS
+++ b/NEWS
@@ -1831,6 +1831,8 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0:
     (reported by Markus Krummenacker)
   * bug fix: FORMATTER can successfully compile pretty-printer format
     strings which use variants of the ~* directive inside.
+  * bug fix: SEARCH now applies its TEST predicate to the elements of
+    the arguments in the correct order.  (thanks to Wolfhard Buss)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** NIL is now allowed as a structure slot name.
     ** arbitrary numbers, not just reals, are allowed in certain
diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index ec14add..b081375 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -2240,14 +2240,14 @@
        ((or (null main) (null sub) (= (the fixnum end1) jndex))
 	t)
      (declare (fixnum jndex))
-     (compare-elements (car main) (car sub))))
+     (compare-elements (car sub) (car main))))
 
 (sb!xc:defmacro search-compare-list-vector (main sub)
   `(do ((main ,main (cdr main))
 	(index start1 (1+ index)))
        ((or (null main) (= index (the fixnum end1))) t)
      (declare (fixnum index))
-     (compare-elements (car main) (aref ,sub index))))
+     (compare-elements (aref ,sub index) (car main))))
 
 (sb!xc:defmacro search-compare-vector-list (main sub index)
   `(do ((sub (nthcdr start1 ,sub) (cdr sub))
@@ -2255,14 +2255,14 @@
 	(index ,index (1+ index)))
        ((or (= (the fixnum end1) jndex) (null sub)) t)
      (declare (fixnum jndex index))
-     (compare-elements (aref ,main index) (car sub))))
+     (compare-elements (car sub) (aref ,main index))))
 
 (sb!xc:defmacro search-compare-vector-vector (main sub index)
   `(do ((index ,index (1+ index))
 	(sub-index start1 (1+ sub-index)))
        ((= sub-index (the fixnum end1)) t)
      (declare (fixnum sub-index index))
-     (compare-elements (aref ,main index) (aref ,sub sub-index))))
+     (compare-elements (aref ,sub sub-index) (aref ,main index))))
 
 (sb!xc:defmacro search-compare (main-type main sub index)
   (if (eq main-type 'list)
diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 3bce548..9d0df27 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -140,8 +140,11 @@
                    (t
                     '*))
             ,(cond ((constant-continuation-p dims)
-                    (let ((val (continuation-value dims)))
-                      (if (listp val) val (list val))))
+                    (let* ((val (continuation-value dims))
+			   (cdims (if (listp val) val (list val))))
+		      (if (or simple (/= (length cdims) 1))
+			  cdims
+			  '(*))))
                    ((csubtypep (continuation-type dims)
                                (specifier-type 'integer))
                     '(*))
diff --git a/tests/vector.pure.lisp b/tests/vector.pure.lisp
index 210f7b6..595d588 100644
--- a/tests/vector.pure.lisp
+++ b/tests/vector.pure.lisp
@@ -32,3 +32,15 @@
 	     (vector-push-extend #\a complex-t)
 	     (assert (= (length complex-t) 4))
 	     (assert (raises-error? (vector-push-extend #\b simple-t))))))
+
+(multiple-value-bind (fp1 index fp2 bool)
+    (let ((a (make-array '(5) :fill-pointer 5 :adjustable 5
+			 :initial-contents '(a b c d e))))
+      (values (fill-pointer a)
+	      (vector-push-extend 'x a)
+	      (fill-pointer a)
+	      (<= (array-total-size a) 5)))
+  (assert (= fp1 5))
+  (assert (= index 5))
+  (assert (= fp2 6))
+  (assert (not bool)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 16961ff..6d3862c 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.0.69"
+"0.8.0.70"
-- 
1.7.10.4