+(untrace test:function)
+
+;;;; No bogus violations from defclass with accessors in a locked
+;;;; package. Reported by by Francois-Rene Rideau.
+(assert (package-locked-p :sb-gray))
+(multiple-value-bind (fun compile-errors)
+ (ignore-errors
+ (compile
+ nil
+ '(lambda ()
+ (defclass fare-class ()
+ ((line-column :initform 0 :reader sb-gray:stream-line-column))))))
+ (assert (not compile-errors))
+ (assert fun)
+ (multiple-value-bind (class run-errors) (ignore-errors (funcall fun))
+ (assert (not run-errors))
+ (assert (eq class (find-class 'fare-class)))))
+
+;;;; No bogus violations from DECLARE's done by PCL behind the
+;;;; scenes. Reported by David Wragg on sbcl-help.
+(reset-test t)
+
+(defmethod pcl-type-declaration-method-bug ((test:*special* stream))
+ test:*special*)
+(assert (eq *terminal-io* (pcl-type-declaration-method-bug *terminal-io*)))
+
+#+#.(cl:if (cl:eq sb-ext:*evaluator-mode* :compile) '(and) '(or))
+(assert (raises-error?
+ (eval
+ '(defmethod pcl-type-declaration-method-bug ((test:*special* stream))
+ (declare (type stream test:*special*))
+ test:*special*))
+ program-error))
+
+;;; Bogus package lock violations from LOOP
+
+(assert (equal (loop :for *print-base* :from 2 :to 3 :collect *print-base*)
+ '(2 3)))
+
+;;; Package lock for DEFMACRO -> DEFUN and vice-versa.
+(reset-test t)
+(with-test (:name :bug-576637)
+ (assert (raises-error? (eval `(defun test:macro (x) x))
+ sb-ext:package-lock-violation))
+ (assert (eq 'test:macro (eval `(test:macro))))
+ (assert (raises-error? (eval `(defmacro test:function (x) x))
+ sb-ext:package-lock-violation))
+ (assert (eq 'test:function (eval `(test:function)))))
+
+(defpackage :macro-killing-macro-1
+ (:use :cl)
+ (:lock t)
+ (:export #:to-die-for))
+
+(defpackage :macro-killing-macro-2
+ (:use :cl :macro-killing-macro-1))
+
+(ctu:file-compile
+ `((in-package :macro-killing-macro-1)
+ (defmacro to-die-for ()
+ :original))
+ :load t)
+
+(with-test (:name :defmacro-killing-macro)
+ (ignore-errors
+ (ctu:file-compile
+ `((in-package :macro-killing-macro-2)
+ (defmacro to-die-for ()
+ :replacement))))
+ (assert (eq :original (macroexpand '(macro-killing-macro-1:to-die-for)))))
+
+(with-test (:name :setf-macro-function-killing-macro)
+ (ignore-errors
+ (ctu:file-compile
+ `((in-package :macro-killing-macro-2)
+ (eval-when (:compile-toplevel)
+ (setf (macro-function 'to-die-for) (constantly :replacement2))))))
+ (assert (eq :original (macroexpand '(macro-killing-macro-1:to-die-for)))))
+
+(with-test (:name :compile-time-defun-package-locked)
+ ;; Make sure compile-time side-effects of DEFUN are protected against.
+ (let ((inline-lambda (function-lambda-expression #'fill-pointer)))
+ ;; Make sure it's actually inlined...
+ (assert inline-lambda)
+ (assert (eq :ok
+ (handler-case
+ (ctu:file-compile `((defun fill-pointer (x) x)))
+ (sb-ext:symbol-package-locked-error (e)
+ (when (eq 'fill-pointer
+ (sb-ext:package-locked-error-symbol e))
+ :ok)))))
+ (assert (equal inline-lambda
+ (function-lambda-expression #'fill-pointer)))))
+
+(with-test (:name :compile-time-defclass-package-locked)
+ ;; Compiling (DEFCLASS FTYPE ...) used to break SBCL, but the package
+ ;; locks didn't kick in till later.
+ (assert (eq :ok
+ (handler-case
+ (ctu:file-compile `((defclass ftype () ())))
+ (sb-ext:symbol-package-locked-error (e)
+ (when (eq 'ftype (sb-ext:package-locked-error-symbol e))
+ :ok)))))
+ ;; Check for accessor violations as well.
+ (assert (eq :ok
+ (handler-case
+ (ctu:file-compile `((defclass foo () ((ftype :reader ftype)))))
+ (sb-ext:symbol-package-locked-error (e)
+ (when (eq 'ftype (sb-ext:package-locked-error-symbol e))
+ :ok))))))