contrib/sb-introspect/xref-test.lisp

   1 (defpackage :sb-introspect-test/xref
   2   (:use "SB-INTROSPECT" "CL"))
   3
   4 (in-package :sb-introspect-test/xref)
   5
   6 (load (compile-file (merge-pathnames "xref-test-data.lisp" *load-pathname*)))
   7
   8 (labels ((natural< (a b)
   9            (string< (princ-to-string a) (princ-to-string b))))
  10   (let ((tests '(((sb-introspect::who-calls 'foo) ())
  11                  ((sb-introspect::who-calls 'bar) (xref/1 xref/3))
  12                  ((sb-introspect::who-calls 'xref/1) (xref/2))
  13                  ((sb-introspect::who-calls 'xref/2)
  14                   (xref/5 xref/6 xref/8 xref/8 xref/12
  15                    (sb-pcl::fast-method xref/10
  16                                         (t t t t t t t t fixnum))
  17                    (sb-pcl::fast-method xref/11 (fixnum))))
  18                  ((sb-introspect::who-calls 'xref/3)
  19                   (inline/1 (sb-pcl::fast-method xref/11 (float))))
  20                  ((sb-introspect::who-calls 'xref/4) ())
  21                  ((sb-introspect::who-calls 'xref/5) ())
  22                  ((sb-introspect::who-calls 'xref/6) (xref/7))
  23                  ((sb-introspect::who-calls 'xref/7) ())
  24                  ((sb-introspect::who-calls 'xref/8) ())
  25                  ((sb-introspect::who-calls 'xref/10) ())
  26                  ((sb-introspect::who-calls 'xref/11) ())
  27                  ((sb-introspect::who-calls 'inline/1) (xref/12))
  28                  ((sb-introspect::who-calls 'xref/12) (macro/1))
  29                  ((sb-introspect::who-macroexpands 'macro/1)
  30                   (macro-use/1 macro-use/2 macro-use/3 macro-use/4 inline/2))
  31                  ((sb-introspect::who-binds '*a*) (xref/2))
  32                  ((sb-introspect::who-sets '*a*) (xref/2))
  33                  ((sb-introspect::who-references '*a*)
  34                   (xref/1 xref/2 xref/4 inline/1))
  35                  ((sb-introspect::who-references '+z+)
  36                   (inline/1)))))
  37     (loop for x in tests
  38           for form = (first x)
  39           for wanted = (sort (second x) #'natural<)
  40           for result = (sort (loop for name in (eval form)
  41                                    collect (car name))
  42                              #'natural<)
  43           do (assert (equalp wanted result)
  44                      nil
  45                      "form=~a~%wanted=~a~%result=~a~%" form wanted result))))
  46