contrib/sb-introspect/xref-test.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package :sb-introspect-test/xref)
  11
  12 (deftest xrefs
  13     (labels ((natural< (a b)
  14                (string< (princ-to-string a) (princ-to-string b))))
  15       (let ((tests '(((sb-introspect::who-calls 'foo) ())
  16                      ((sb-introspect::who-calls 'bar) (xref/1 xref/3))
  17                      ((sb-introspect::who-calls 'xref/1) (xref/2))
  18                      ((sb-introspect::who-calls 'xref/2)
  19                       (xref/5 xref/6 xref/8 xref/8 xref/12
  20                        (sb-pcl::fast-method xref/10
  21                                             (t t t t t t t t fixnum))
  22                        (sb-pcl::fast-method xref/11 (fixnum))))
  23                      ((sb-introspect::who-calls 'xref/3)
  24                       (inline/1 (sb-pcl::fast-method xref/11 (float))))
  25                      ((sb-introspect::who-calls 'xref/4) ())
  26                      ((sb-introspect::who-calls 'xref/5) ())
  27                      ((sb-introspect::who-calls 'xref/6) (xref/7))
  28                      ((sb-introspect::who-calls 'xref/7) ())
  29                      ((sb-introspect::who-calls 'xref/8) ())
  30                      ((sb-introspect::who-calls 'xref/10) ())
  31                      ((sb-introspect::who-calls 'xref/11) ())
  32                      ((sb-introspect::who-calls 'inline/1) (xref/12))
  33                      ((sb-introspect::who-calls 'xref/12) (macro/1))
  34                      ((sb-introspect::who-calls 'inline/3)
  35                       (inline/3-user/1 inline/3-user/2 inline/3-user/3 inline/3-user/4))
  36                      ((sb-introspect::who-calls 'inline/4) (inline/4-user))
  37                      ((sb-introspect::who-macroexpands 'macro/1)
  38                       (macro-use/1 macro-use/2 macro-use/3 macro-use/4 inline/2))
  39                      ((sb-introspect::who-binds '*a*) (xref/2))
  40                      ((sb-introspect::who-sets '*a*) (xref/2 xref/13))
  41                      ((sb-introspect::who-references '*a*)
  42                       (xref/1 xref/2 xref/4 inline/1 xref/14))
  43                      ((sb-introspect::who-references '+z+)
  44                       (inline/1)))))
  45         (loop for x in tests
  46               for form = (first x)
  47               for wanted = (sort (second x) #'natural<)
  48               for result = (sort (loop for name in (eval form)
  49                                        collect (car name))
  50                                  #'natural<)
  51               do (unless (equalp wanted result)
  52                    (return (format nil "form=~a~%wanted=~a~%result=~a~%"
  53                                    form wanted result))))))
  54   nil)