[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] CVS: sbcl/contrib/sb-introspect introspect.lisp, 1.3,
From:       "Tobias Rittweiler" <trittweiler () users ! sourceforge ! net>
Date:       2009-11-24 16:31:21
Message-ID: E1NCyIT-0000vH-Ib () sfp-cvsdas-3 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]

Update of /cvsroot/sbcl/sbcl/contrib/sb-introspect
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv3525/contrib/sb-introspect

Modified Files:
	introspect.lisp 
Log Message:
1.0.32.38: liberalize WHO-SPECIALIZES-DIRECTLY/GENERALLY

Other Xref functions (WHO-CALLS etc.) are very liberal at what they
accept as input. Adjust the two new Xref functions
WHO-SPECIALIZES-DIRECTLY and WHO-SEPCIALIZES-GENERALLY accordingly.


Index: introspect.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-introspect/introspect.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- introspect.lisp	11 Nov 2009 15:06:29 -0000	1.3
+++ introspect.lisp	24 Nov 2009 16:31:19 -0000	1.4
@@ -639,6 +639,8 @@
 Experimental.
 "
   (let ((class (canonicalize-class-designator class-designator)))
+    (unless class
+      (return-from who-specializes-directly nil))
     (let ((result (collect-specializing-methods
                    #'(lambda (specl)
                        ;; Does SPECL specialize on CLASS directly?
@@ -670,6 +672,8 @@
 Experimental.
 "
   (let ((class (canonicalize-class-designator class-designator)))
+    (unless class
+      (return-from who-specializes-generally nil))
     (let ((result (collect-specializing-methods
                    #'(lambda (specl)
                        ;; Does SPECL specialize on CLASS or a subclass
@@ -689,9 +693,10 @@
                 result))))
 
 (defun canonicalize-class-designator (class-designator)
-  (etypecase class-designator
-    (symbol (find-class class-designator))
-    (class  class-designator)))
+  (typecase class-designator
+    (symbol (find-class class-designator nil))
+    (class  class-designator)
+    (t nil)))
 
 (defun method-generic-function-name (method)
   (sb-mop:generic-function-name (sb-mop:method-generic-function method)))


------------------------------------------------------------------------------
Let Crystal Reports handle the reporting - Free Crystal Reports 2008 30-Day 
trial. Simplify your report design, integration and deployment - and focus on 
what you do best, core application coding. Discover what's new with
Crystal Reports now.  http://p.sf.net/sfu/bobj-july
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]