+
+;;; Stack allocating a value cell in HANDLER-CASE would blow up stack
+;;; in an unfortunate loop.
+(defun handler-case-eating-stack ()
+ (let ((sp nil))
+ (do ((n 0 (logand most-positive-fixnum (1+ n))))
+ ((>= n 1024))
+ (multiple-value-bind (value error) (ignore-errors)
+ (when (and value error) nil))
+ (if sp
+ (assert (= sp (sb-c::%primitive sb-c:current-stack-pointer)))
+ (setf sp (sb-c::%primitive sb-c:current-stack-pointer))))))
+(with-test (:name :handler-case-eating-stack)
+ (assert-no-consing (handler-case-eating-stack)))
+
+;;; A nasty bug where RECHECK-DYNAMIC-EXTENT-LVARS thought something was going
+;;; to be stack allocated when it was not, leading to a bogus %NIP-VALUES.
+;;; Fixed by making RECHECK-DYNAMIC-EXTENT-LVARS deal properly with nested DX.
+(deftype vec ()
+ `(simple-array single-float (3)))
+(declaim (ftype (function (t t t) vec) vec))
+(declaim (inline vec))
+(defun vec (a b c)
+ (make-array 3 :element-type 'single-float :initial-contents (list a b c)))
+(defun bad-boy (vec)
+ (declare (type vec vec))
+ (lambda (fun)
+ (let ((vec (vec (aref vec 0) (aref vec 1) (aref vec 2))))
+ (declare (dynamic-extent vec))
+ (funcall fun vec))))
+(with-test (:name :recheck-nested-dx-bug)
+ (assert (funcall (bad-boy (vec 1.0 2.0 3.3))
+ (lambda (vec) (equalp vec (vec 1.0 2.0 3.3)))))
+ (flet ((foo (x) (declare (ignore x))))
+ (let ((bad-boy (bad-boy (vec 2.0 3.0 4.0))))
+ (assert-no-consing (funcall bad-boy #'foo)))))