[Sbcl-commits] CVS: sbcl/tests compiler.impure.lisp,1.58,1.59

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27499/tests

Modified Files:
	compiler.impure.lisp 
Log Message:
0.8.21.37: fix bug 305
 * annotate the inline/notinline fun with type-restrictions from the
    environment.



Index: compiler.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -d -r1.58 -r1.59
--- compiler.impure.lisp	1 Apr 2005 16:48:09 -0000	1.58
+++ compiler.impure.lisp	13 Apr 2005 21:08:40 -0000	1.59
@@ -998,5 +998,36 @@
   (print output)
   (assert (zerop (length output))))
 
+;;;; bug 305: INLINE/NOTINLINE causing local ftype to be lost
+
+(define-condition optimization-error (error) ())
+
+(labels ((compile-lambda (type sense)
+	   (handler-bind ((compiler-note (lambda (_)
+					   (declare (ignore _))
+					   (error 'optimization-error))))
+	     (values
+	      (compile 
+	       nil
+	       `(lambda ()
+		  (declare 
+		   ,@(when type '((ftype (function () (integer 0 10)) bug-305)))
+		   (,sense bug-305)
+		   (optimize speed))
+		  (1+ (bug-305))))
+	      nil)))
+	 (expect-error (sense)
+	   (multiple-value-bind (f e)  (ignore-errors (compile-lambda nil sense))
+	     (assert (not f))
+	     (assert (typep e 'optimization-error))))
+	 (expect-pass (sense)
+	   (multiple-value-bind (f e)  (ignore-errors (compile-lambda t sense))
+	     (assert f)
+	     (assert (not e)))))
+  (expect-error 'inline)
+  (expect-error 'notinline)
+  (expect-pass 'inline)
+  (expect-pass 'notinline))
+
 ;;; success
 (quit :unix-status 104)