(declare (type (signed-byte 31) x))
(sb-c::mask-signed-field 31 (- x 1055131947))))))
(assert (= (funcall fun 10038) -1055121909))))
+
+(with-test (:name :first-open-coded)
+ (let ((fun (compile nil `(lambda (x) (first x)))))
+ (assert (not (ctu:find-named-callees fun)))))
+
+(with-test (:name :second-open-coded)
+ (let ((fun (compile nil `(lambda (x) (second x)))))
+ (assert (not (ctu:find-named-callees fun)))))
+
+(with-test (:name :svref-of-symbol-macro)
+ (compile nil `(lambda (x)
+ (symbol-macrolet ((sv x))
+ (values (svref sv 0) (setf (svref sv 0) 99))))))
+
+;; The compiler used to update the receiving LVAR's type too
+;; aggressively when converting a large constant to a smaller
+;; (potentially signed) one, causing other branches to be
+;; inferred as dead.
+(with-test (:name :modular-cut-constant-to-width)
+ (let ((test (compile nil
+ `(lambda (x)
+ (logand 254
+ (case x
+ ((3) x)
+ ((2 2 0 -2 -1 2) 9223372036854775803)
+ (t 358458651)))))))
+ (assert (= (funcall test -10470605025) 26))))
+
+(with-test (:name :append-type-derivation)
+ (let ((test-cases
+ '((lambda () (append 10)) (integer 10 10)
+ (lambda () (append nil 10)) (integer 10 10)
+ (lambda (x) (append x 10)) t
+ (lambda (x) (append x (cons 1 2))) cons
+ (lambda (x y) (append x (cons 1 2) y)) cons
+ (lambda (x y) (nconc x (the list y) x)) t
+ (lambda (x y) (print (length y)) (append x y)) sequence)))
+ (loop for (function result-type) on test-cases by #'cddr
+ do (assert (equal (car (cdaddr (sb-kernel:%simple-fun-type
+ (compile nil function))))
+ result-type)))))
+
+(with-test (:name :bug-504121)
+ (compile nil `(lambda (s)
+ (let ((p1 #'upper-case-p))
+ (funcall
+ (lambda (g)
+ (funcall p1 g))))
+ (let ((p2 #'(lambda (char) (upper-case-p char))))
+ (funcall p2 s)))))
+
+(with-test (:name (:bug-504121 :optional-missing))
+ (compile nil `(lambda (s)
+ (let ((p1 #'upper-case-p))
+ (funcall
+ (lambda (g &optional x)
+ (funcall p1 g))))
+ (let ((p2 #'(lambda (char) (upper-case-p char))))
+ (funcall p2 s)))))
+
+(with-test (:name (:bug-504121 :optional-superfluous))
+ (compile nil `(lambda (s)
+ (let ((p1 #'upper-case-p))
+ (funcall
+ (lambda (g &optional x)
+ (funcall p1 g))
+ #\1 2 3))
+ (let ((p2 #'(lambda (char) (upper-case-p char))))
+ (funcall p2 s)))))
+
+(with-test (:name (:bug-504121 :key-odd))
+ (compile nil `(lambda (s)
+ (let ((p1 #'upper-case-p))
+ (funcall
+ (lambda (g &key x)
+ (funcall p1 g))
+ #\1 :x))
+ (let ((p2 #'(lambda (char) (upper-case-p char))))
+ (funcall p2 s)))))
+
+(with-test (:name (:bug-504121 :key-unknown))
+ (compile nil `(lambda (s)
+ (let ((p1 #'upper-case-p))
+ (funcall
+ (lambda (g &key x)
+ (funcall p1 g))
+ #\1 :y 2))
+ (let ((p2 #'(lambda (char) (upper-case-p char))))
+ (funcall p2 s)))))