X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefpackage.lisp;h=efb100e05759f52c8683f2d1d5324f80de7456d2;hb=bfa4310e41dcd011ca9d139f29be1c5757b41378;hp=ab297791b12fa1cd28951fc2d26239eac5facb6b;hpb=b1abaa98c141c3f9baceb1185086fde7b5256e98;p=sbcl.git

diff --git a/src/code/defpackage.lisp b/src/code/defpackage.lisp
index ab29779..efb100e 100644
--- a/src/code/defpackage.lisp
+++ b/src/code/defpackage.lisp
@@ -136,8 +136,8 @@
 
 (defun stringify-name (name kind)
   (typecase name
-    (simple-string name)
-    (string (coerce name 'simple-string))
+    (simple-base-string name)
+    (string (coerce name 'simple-base-string))
     (symbol (symbol-name name))
     (base-char (string name))
     (t
@@ -182,8 +182,9 @@
 	      (shadowing-import sym package)
 	      (setf old-shadows (remove sym old-shadows))))))
       (when old-shadows
-	(warn "~A also shadows the following symbols:~%  ~S"
-	      name old-shadows)))
+	(warn 'package-at-variance
+	      :format-control "~A also shadows the following symbols:~%  ~S"
+	      :format-arguments (list name old-shadows))))
     ;; Handle USE.
     (unless (eq use :default)
       (let ((old-use-list (package-use-list package))
@@ -192,9 +193,9 @@
 	(let ((laterize (set-difference old-use-list new-use-list)))
 	  (when laterize
 	    (unuse-package laterize package)
-	    (warn "~A used to use the following packages:~%  ~S"
-		  name
-		  laterize)))))
+	    (warn 'package-at-variance
+		  :format-control "~A used to use the following packages:~%  ~S"
+		  :format-arguments (list name laterize))))))
     ;; Handle IMPORT and INTERN.
     (dolist (sym-name interns)
       (intern sym-name package))
@@ -213,7 +214,9 @@
       (export exports package)
       (let ((diff (set-difference old-exports exports)))
 	(when diff
-	  (warn "~A also exports the following symbols:~%  ~S" name diff))))
+	  (warn 'package-at-variance
+		:format-control "~A also exports the following symbols:~%  ~S" 
+		:format-arguments (list name diff)))))
     ;; Handle documentation.
     (setf (package-doc-string package) doc-string)
     package))