contrib/sb-introspect/sb-introspect.asd

   1 ;;; -*-  Lisp -*-
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (defpackage :sb-introspect-system
  13   (:use :asdf :cl))
  14
  15 (in-package :sb-introspect-system)
  16
  17 (defsystem :sb-introspect
  18   :components ((:file "introspect")))
  19
  20 (defmethod perform :after ((o load-op) (c (eql (find-system :sb-introspect))))
  21   (provide 'sb-introspect))
  22
  23 (defmethod perform ((o test-op) (c (eql (find-system :sb-introspect))))
  24   (operate 'load-op :sb-introspect-tests)
  25   (operate 'test-op :sb-introspect-tests))
  26
  27 (defclass plist-file (cl-source-file)
  28   ((source-plist
  29     :initform nil
  30     :initarg :source-plist
  31     :reader plist-file-source-plist)))
  32
  33 (defmethod perform ((op compile-op) (com plist-file))
  34   (with-compilation-unit (:source-plist (plist-file-source-plist com))
  35     (call-next-method)))
  36
  37 (defmethod perform ((op load-op) (com plist-file))
  38   (with-compilation-unit (:source-plist (plist-file-source-plist com))
  39     (call-next-method)))
  40
  41 (defclass source-only-file (cl-source-file)
  42   ())
  43
  44 (defmethod perform ((op compile-op) (com source-only-file)))
  45
  46 (defmethod output-files ((op compile-op) (com source-only-file))
  47   (list (component-pathname com)))
  48
  49 (defsystem :sb-introspect-tests
  50   :depends-on (:sb-introspect :sb-rt)
  51   :components ((:file "xref-test-data")
  52                (:file "xref-test" :depends-on ("xref-test-data"))
  53                (:plist-file "test" :source-plist (:test-outer "OUT"))
  54                (:source-only-file "load-test")
  55                (:file "test-driver" :depends-on ("test" "load-test"))))
  56
  57 (defmethod perform ((op test-op) (com (eql (find-system :sb-introspect-tests))))
  58   ;; N.b. At least DEFINITION-SOURCE-PLIST.1 assumes that CWD is the
  59   ;; contrib/sb-introspect directory which is true for when this is
  60   ;; implicitly run via make-target-contribs.sh -- but not when this
  61   ;; is executed manually.
  62   (let ((*default-pathname-defaults*
  63          (make-pathname :directory (pathname-directory
  64                                     '#.(or *compile-file-pathname*
  65                                            *load-pathname*)))))
  66     (multiple-value-bind (soft strict #+sb-testing-contrib pending)
  67         (funcall (find-symbol "DO-TESTS" "SB-RT"))
  68       (fresh-line)
  69       (unless strict
  70         #+sb-testing-contrib
  71         ;; We create TEST-PASSED from a shell script if tests passed.  But
  72         ;; since the shell script only `touch'es it, we can actually create
  73         ;; it ahead of time -- as long as we're certain that tests truly
  74         ;; passed, hence the check for SOFT.
  75         (when soft
  76           (with-open-file (s #p"SYS:CONTRIB;SB-INTROSPECT;TEST-PASSED"
  77                              :direction :output)
  78             (dolist (pend pending)
  79               (format s "Expected failure: ~A~%" pend))))
  80         (warn "ignoring expected failures in test-op"))
  81       (unless soft
  82         (error "test-op failed with unexpected failures")))))