0.pre7.52:

[sbcl.git] / tests / compiler.pure.lisp

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 9a01572..1fa6e25 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1,6 +1,19 @@
+;;;; various compiler tests without side-effects
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;; 
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
 (cl:in-package :cl-user)
 
-;;; Exercise a compiler bug by (crashing the compiler).
+;;; Exercise a compiler bug (by crashing the compiler).
 ;;;
 ;;; This test code is from Douglas Crosher's simplified TICKLE-BUG
 ;;; (2000-09-06 on cmucl-imp).
@@ -25,3 +38,21 @@
 
                       (fun1)
                       nil))))
+
+;;; Exercise a compiler bug (by crashing the compiler).
+;;;
+;;; Tim Moore gave a patch for this bug in CMU CL 2000-05-24 on 
+;;; cmucl-imp, and Martin Atzmueller applied it to SBCL.
+(funcall (compile nil
+                 '(lambda (x)
+                    (or (integerp x)
+                        (block used-by-some-y?
+                          (flet ((frob (stk)
+                                   (dolist (y stk)
+                                     (unless (rejected? y)
+                                       (return-from used-by-some-y? t)))))
+                            (declare (inline frob))
+                            (frob (rstk x))
+                            (frob (mrstk x)))
+                          nil))))
+        13)