1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
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 ()
|
