(assert (search "INLINED-FUNCTION-IN-SOURCE-PATH" output))
;; ...not the leaf.
(assert (not (search "DEFINED-FUN" output)))))
+
+(defmacro bug-795705 ()
+ t)
+
+(with-test (:name :bug-795705)
+ (assert (macro-function 'bug-795705))
+ (fmakunbound 'bug-795705)
+ (assert (not (macro-function 'bug-795705))))
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself
(assert (equal "foobar" (type-error-datum e)))
:type-error))))))
+(declaim (unsigned-byte *symbol-value-test-var*))
+(defvar *symbol-value-test-var*)
+
+(declaim (unsigned-byte **global-symbol-value-test-var**))
+(defglobal **global-symbol-value-test-var** 0)
+
+(test-util:with-test (:name :symbol-value-type-derivation)
+ (let ((fun (compile
+ nil
+ `(lambda ()
+ *symbol-value-test-var*))))
+ (assert (equal '(function () (values unsigned-byte &optional))
+ (%simple-fun-type fun))))
+ (let ((fun (compile
+ nil
+ `(lambda ()
+ **global-symbol-value-test-var**))))
+ (assert (equal '(function () (values unsigned-byte &optional))
+ (%simple-fun-type fun))))
+ (let ((fun (compile
+ nil
+ `(lambda (*symbol-value-test-var*)
+ (declare (fixnum *symbol-value-test-var*))
+ (symbol-value '*symbol-value-test-var*))))
+ (ufix (type-specifier (specifier-type `(and unsigned-byte fixnum)))))
+ (assert (equal `(function (,ufix) (values ,ufix &optional))
+ (%simple-fun-type fun))))
+ (let ((fun (compile
+ nil
+ `(lambda ()
+ (declare (fixnum **global-symbol-value-test-var**))
+ (symbol-global-value '**global-symbol-value-test-var**))))
+ (ufix (type-specifier (specifier-type `(and unsigned-byte fixnum)))))
+ (assert (equal `(function () (values ,ufix &optional))
+ (%simple-fun-type fun)))))
+
+(test-util:with-test (:name :mv-bind-to-let-type-propagation)
+ (let ((f (compile nil `(lambda (x)
+ (declare (optimize speed)
+ (type (integer 20 50) x))
+ (< (truncate x 10) 1))))
+ (g (compile nil `(lambda (x)
+ (declare (optimize speed)
+ (type (integer 20 50) x))
+ (< (nth-value 1 (truncate x 10)) 10))))
+ (h (compile nil `(lambda (x)
+ (declare (optimize speed)
+ (type (integer 20 50) x))
+ (multiple-value-bind (q r)
+ (truncate x 10)
+ (declare (ignore r))
+ (< q 1)))))
+ (type0 '(function ((integer 20 50)) (values null &optional)))
+ (type1 '(function ((integer 20 50)) (values (member t) &optional))))
+ (assert (equal type0 (sb-kernel:%simple-fun-type f)))
+ (assert (equal type1 (sb-kernel:%simple-fun-type g)))
+ (assert (equal type0 (sb-kernel:%simple-fun-type h)))))
+
;;; success