[armedbear-cvs] r14427 - trunk/abcl/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Fri Mar  8 06:53:47 2013
New Revision: 14427

Log:
Fix warn on redefinition for case when symbol has no source pathname.

This can occur for system symbols implemented in Java.

Modified:
   trunk/abcl/src/org/armedbear/lisp/fdefinition.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/fdefinition.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/fdefinition.lisp	Thu Mar  7 13:38:26 2013	(r14426)
+++ trunk/abcl/src/org/armedbear/lisp/fdefinition.lisp	Fri Mar  8 06:53:47 2013	(r14427)
@@ -35,26 +35,27 @@
 
 (defun check-redefinition (name)
   (when (and *warn-on-redefinition* (fboundp name) (not (autoloadp name)))
-    (cond ((symbolp name)
-           (let ((old-source 
-                  (if (keywordp (source-pathname name))
-                      (source-pathname name)
-                      (truename (source-pathname name))))
-                 (current-source 
-                  (if (not *source*) 
-                      :top-level
-                      (truename *source*))))
-             (cond ((equal old-source 
-                           current-source)) ; OK
-                   (t
-                    (if (eq current-source :top-level)
-                        (style-warn "redefining ~S at top level" name)
-                        (let ((*package* +cl-package+))
-                          (if (eq old-source :top-level)
-                              (style-warn "redefining ~S in ~S (previously defined at top level)"
-                                          name current-source)
-                              (style-warn "redefining ~S in ~S (previously defined in ~S)"
-                                          name current-source old-source)))))))))))
+    (when (and (symbolp name)
+               (source-pathname name))
+      (let ((old-source 
+             (if (keywordp (source-pathname name))
+                 (source-pathname name)
+                 (truename (source-pathname name))))
+            (current-source 
+             (if (not *source*) 
+                 :top-level
+                 (truename *source*))))
+        (cond ((equal old-source 
+                      current-source)) ; OK
+              (t
+               (if (eq current-source :top-level)
+                   (style-warn "redefining ~S at top level" name)
+                   (let ((*package* +cl-package+))
+                     (if (eq old-source :top-level)
+                         (style-warn "redefining ~S in ~S (previously defined at top level)"
+                                     name current-source)
+                         (style-warn "redefining ~S in ~S (previously defined in ~S)"
+                                     name current-source old-source))))))))))
 
 (defun record-source-information (name &optional source-pathname source-position)
   (unless source-pathname