X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fxref-test.lisp;h=a93740df318e023e2adde4bab377903bce2c5512;hb=6548750bc1ca4d832afed1744cdc7133b232c6f2;hp=dd3b33835f8677dc580335d86ede06a3c6b9ed18;hpb=d351f80b1076dd54e5aee3dacab82d59c2e58060;p=sbcl.git

diff --git a/contrib/sb-introspect/xref-test.lisp b/contrib/sb-introspect/xref-test.lisp
index dd3b338..a93740d 100644
--- a/contrib/sb-introspect/xref-test.lisp
+++ b/contrib/sb-introspect/xref-test.lisp
@@ -9,43 +9,138 @@
 
 (in-package :sb-introspect-test/xref)
 
-(deftest xrefs
-    (labels ((natural< (a b)
-               (string< (princ-to-string a) (princ-to-string b))))
-      (let ((tests '(((sb-introspect::who-calls 'foo) ())
-                     ((sb-introspect::who-calls 'bar) (xref/1 xref/3))
-                     ((sb-introspect::who-calls 'xref/1) (xref/2))
-                     ((sb-introspect::who-calls 'xref/2)
-                      (xref/5 xref/6 xref/8 xref/8 xref/12
-                       (sb-pcl::fast-method xref/10
-                                            (t t t t t t t t fixnum))
-                       (sb-pcl::fast-method xref/11 (fixnum))))
-                     ((sb-introspect::who-calls 'xref/3)
-                      (inline/1 (sb-pcl::fast-method xref/11 (float))))
-                     ((sb-introspect::who-calls 'xref/4) ())
-                     ((sb-introspect::who-calls 'xref/5) ())
-                     ((sb-introspect::who-calls 'xref/6) (xref/7))
-                     ((sb-introspect::who-calls 'xref/7) ())
-                     ((sb-introspect::who-calls 'xref/8) ())
-                     ((sb-introspect::who-calls 'xref/10) ())
-                     ((sb-introspect::who-calls 'xref/11) ())
-                     ((sb-introspect::who-calls 'inline/1) (xref/12))
-                     ((sb-introspect::who-calls 'xref/12) (macro/1))
-                     ((sb-introspect::who-macroexpands 'macro/1)
-                      (macro-use/1 macro-use/2 macro-use/3 macro-use/4 inline/2))
-                     ((sb-introspect::who-binds '*a*) (xref/2))
-                     ((sb-introspect::who-sets '*a*) (xref/2 xref/13))
-                     ((sb-introspect::who-references '*a*)
-                      (xref/1 xref/2 xref/4 inline/1 xref/14))
-                     ((sb-introspect::who-references '+z+)
-                      (inline/1)))))
-        (loop for x in tests
-              for form = (first x)
-              for wanted = (sort (second x) #'natural<)
-              for result = (sort (loop for name in (eval form)
-                                       collect (car name))
-                                 #'natural<)
-              do (unless (equalp wanted result)
-                   (return (format nil "form=~a~%wanted=~a~%result=~a~%"
-                                   form wanted result))))))
+(defmacro define-xref-test (name form result)
+  `(deftest ,name
+       (sort (mapcar #'first ,form) #'string< :key #'princ-to-string)
+     ,(sort (copy-list result) #'string< :key #'princ-to-string)))
+
+(define-xref-test who-calls.1
+    (who-calls 'foo)
+  nil)
+(define-xref-test who-calls.2
+    (who-calls 'bar)
+  (xref/1 xref/3))
+
+(define-xref-test who-calls.3
+    (who-calls 'xref/1)
+  (xref/2))
+
+(define-xref-test who-calls.4
+    (who-calls 'xref/2)
+  (xref/5
+   xref/6
+   xref/8
+   xref/8
+   xref/12
+   (sb-pcl::fast-method xref/10 (t t t t t t t t fixnum))
+   (sb-pcl::fast-method xref/11 (fixnum))))
+
+(define-xref-test who-calls.5
+    (who-calls 'xref/3)
+  (inline/1 (sb-pcl::fast-method xref/11 (float))))
+
+(define-xref-test who-calls.6
+    (who-calls 'xref/4)
+  nil)
+
+(define-xref-test who-calls.7
+    (who-calls 'xref/5)
   nil)
+
+(define-xref-test who-calls.8
+    (who-calls 'xref/6)
+  (xref/7))
+
+(define-xref-test who-calls.9
+    (who-calls 'xref/7)
+  nil)
+
+(define-xref-test who-calls.10
+    (who-calls 'xref/8)
+  nil)
+
+(define-xref-test who-calls.11
+    (who-calls 'xref/10)
+  nil)
+(define-xref-test who-calls.12
+    (who-calls 'xref/11)
+  nil)
+
+(define-xref-test who-calls.13
+    (who-calls 'inline/1)
+  (xref/12))
+
+(define-xref-test who-calls.14
+    (who-calls 'xref/12)
+  (macro/1))
+
+(define-xref-test who-calls.15
+    (who-calls 'inline/3)
+  (inline/3-user/1
+   inline/3-user/2
+   inline/3-user/3
+   inline/3-user/4))
+
+(define-xref-test who-calls.16
+    (who-calls 'inline/4)
+  (inline/4-user))
+
+
+(define-xref-test who-macroexpands.1
+    (who-macroexpands 'macro/1)
+  (macro-use/1
+   macro-use/2
+   macro-use/3
+   macro-use/4
+   inline/2))
+
+
+(define-xref-test who-binds.1
+    (who-binds '*a*)
+  (xref/2))
+
+
+(define-xref-test who-sets.1
+    (who-sets '*a*)
+  (xref/2 xref/13))
+
+
+(define-xref-test who-references.1
+    (who-references '*a*)
+  (xref/1 xref/2 xref/4 inline/1 xref/14))
+
+(define-xref-test who-references.2
+    (who-references '+z+)
+  (inline/1))
+
+
+(define-xref-test who-calls.struct-slot.1
+    (who-calls 'struct-slot)
+  (source-user))
+
+(define-xref-test who-calls.cmacro.1
+    (who-calls 'cmacro)
+  (source-user))
+
+
+(define-xref-test who-specializes-directly.1
+    (who-specializes-directly 'a-class)
+  ((method a-gf-1)
+   (method a-gf-2)))
+
+(define-xref-test who-specializes-directly.2
+    (who-specializes-directly 'a-structure)
+  ((method a-gf-1)
+   (method a-gf-2)))
+
+(define-xref-test who-specializes-generally.1
+    (who-specializes-generally 'a-class)
+  ((method a-gf-1)
+   (method a-gf-2)
+   (method a-gf-3)))
+
+(define-xref-test who-specializes-generally.2
+    (who-specializes-generally 'a-structure)
+  ((method a-gf-1)
+   (method a-gf-2)
+   (method a-gf-3)))
\ No newline at end of file