head	1.1;
access;
symbols;
locks; strict;
comment	@# @;


1.1
date	2013.03.03.16.08.09;	author svnexp;	state Exp;
branches;
next	;


desc
@@


1.1
log
@## SVN ## Exported commit - http://svnweb.freebsd.org/changeset/base/313363
## SVN ## CVS IS DEPRECATED: http://wiki.freebsd.org/CvsIsDeprecated
@
text
@diff --git NEWS NEWS
index ca2919b..5ff7f27 100644
--- NEWS
+++ NEWS
@@@@ -1,4 +1,9 @@@@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+changes relative to sbcl-1.1.5:
+  * bug fix: Prevent a make-array transform from modifying source forms
+    causing problems for inlined code. Thanks to Bart Botta.
+   (regression since 1.0.42.11-bis)
+
 changes in sbcl-1.1.5 relative to sbcl-1.1.4:
   * minor incompatible change: SB-SPROF:WITH-PROFILING no longer loops
     by default.
diff --git src/compiler/array-tran.lisp src/compiler/array-tran.lisp
index baf1b98..02c5c37 100644
--- src/compiler/array-tran.lisp
+++ src/compiler/array-tran.lisp
@@@@ -372,7 +372,8 @@@@
                    (values dimensions nil))))
         (let ((initial-contents (getf keyargs :initial-contents)))
           (when (and initial-contents rank)
-            (setf (getf keyargs :initial-contents)
+            (setf keyargs (copy-list keyargs)
+                  (getf keyargs :initial-contents)
                   (rewrite-initial-contents rank initial-contents env))))
         `(locally (declare (notinline list vector))
            (make-array ,new-dimensions ,@@keyargs)))))
diff --git tests/float.impure.lisp tests/float.impure.lisp
index daef1f2..29ca23b 100644
--- tests/float.impure.lisp
+++ tests/float.impure.lisp
@@@@ -248,8 +248,11 @@@@
   (flet ((almost= (x y)
            (< (abs (- x y)) 1d-5)))
     (macrolet ((foo (op value)
-                 `(assert (almost= (,op (mod ,value (* 2 pi)))
-                                   (,op ,value)))))
+                 `(let ((actual (,op ,value))
+                        (expected (,op (mod ,value (* 2 pi)))))
+                    (unless (almost= actual expected)
+                      (error "Inaccurate result for ~a: expected ~a, got ~a"
+                             (list ',op ,value) expected actual)))))
       (let ((big (* pi (expt 2d0 70)))
             (mid (coerce most-positive-fixnum 'double-float))
             (odd (* pi most-positive-fixnum)))
diff --git tests/test-util.lisp tests/test-util.lisp
index 20b2c54..d6246bf 100644
--- tests/test-util.lisp
+++ tests/test-util.lisp
@@@@ -39,7 +39,7 @@@@
 (defmacro with-test ((&key fails-on broken-on skipped-on name)
                      &body body)
   (let ((block-name (gensym))
-        (threads    (gensym "THREADS")))
+        #+sb-thread (threads (gensym "THREADS")))
     `(progn
        (start-test)
        (cond
diff --git tests/threads.impure.lisp tests/threads.impure.lisp
index ddd1ef0..7ebc17c 100644
--- tests/threads.impure.lisp
+++ tests/threads.impure.lisp
@@@@ -37,18 +37,6 @@@@
     (with-mutex (mutex)
       mutex)))
 
-(with-test (:name (:with-mutex :timeout))
-  (let ((m (make-mutex)))
-    (with-mutex (m)
-      (assert (null (join-thread (make-thread
-                                  (lambda ()
-                                    (with-mutex (m :timeout 0.1)
-                                      t)))))))
-    (assert (join-thread (make-thread
-                          (lambda ()
-                            (with-mutex (m :timeout 0.1)
-                              t)))))))
-
 (sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
     void
   (where sb-alien:unsigned-long))
@@@@ -84,6 +72,18 @@@@
 
 ;;;; Now the real tests...
 
+(with-test (:name (:with-mutex :timeout))
+  (let ((m (make-mutex)))
+    (with-mutex (m)
+      (assert (null (join-thread (make-thread
+                                  (lambda ()
+                                    (with-mutex (m :timeout 0.1)
+                                      t)))))))
+    (assert (join-thread (make-thread
+                          (lambda ()
+                            (with-mutex (m :timeout 0.1)
+                              t)))))))
+
 (with-test (:name (:interrupt-thread :deferrables-unblocked-by-lock))
   (let ((lock (sb-thread::make-mutex))
         (thread (make-join-thread (lambda ()
@
