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 (:use :cl :asdf :uiop))
  13 (in-package #:sb-introspect-system)
  14
  15 (defsystem :sb-introspect
  16   :components ((:file "introspect"))
  17   #+sb-building-contrib :pathname
  18   #+sb-building-contrib #p"SYS:CONTRIB;SB-INTROSPECT;"
  19   :perform (load-op :after (o c) (provide 'sb-introspect))
  20   :perform (test-op (o c) (test-system :sb-introspect/tests)))
  21
  22 (defclass plist-file (cl-source-file)
  23   ((source-plist
  24     :initform nil
  25     :initarg :source-plist
  26     :reader plist-file-source-plist)))
  27
  28 (defmethod perform ((op compile-op) (com plist-file))
  29   (with-compilation-unit (:source-plist (plist-file-source-plist com))
  30     (call-next-method)))
  31
  32 (defmethod perform ((op load-op) (com plist-file))
  33   (with-compilation-unit (:source-plist (plist-file-source-plist com))
  34     (call-next-method)))
  35
  36 (defclass source-only-file (cl-source-file)
  37   ())
  38
  39 (defmethod perform ((op compile-op) (com source-only-file)))
  40 (defmethod perform ((op load-op) (com source-only-file)))
  41 (defmethod output-files ((op compile-op) (com source-only-file))
  42   ())
  43 (defmethod component-depends-on ((op load-op) (com source-only-file))
  44   `((load-source-op ,com) ,@(call-next-method)))
  45
  46 (defsystem :sb-introspect/tests
  47   :depends-on (:sb-introspect :sb-rt)
  48   #+sb-building-contrib :pathname
  49   #+sb-building-contrib #p"SYS:CONTRIB;SB-INTROSPECT;"
  50   :components ((:file "xref-test-data")
  51                (:file "xref-test" :depends-on ("xref-test-data"))
  52                (:plist-file "test" :source-plist (:test-outer "OUT") :operation-done-p (compile-op (o c) nil))
  53                (:source-only-file "load-test")
  54                (:file "test-driver" :depends-on ("test" "load-test")))
  55   :perform
  56   (test-op (o c)
  57     ;; N.b. At least DEFINITION-SOURCE-PLIST.1 assumes that CWD is the
  58     ;; contrib/sb-introspect directory which is true for when this is
  59     ;; implicitly run via make-target-contribs.sh -- but not when this
  60     ;; is executed manually.
  61     (let ((*default-pathname-defaults* (translate-logical-pathname (system-source-directory c))))
  62       (multiple-value-bind (soft strict pending) (symbol-call :sb-rt :do-tests)
  63         (declare (ignorable pending))
  64         (fresh-line)
  65         (unless strict
  66           #+sb-testing-contrib
  67           ;; We create TEST-PASSED from a shell script if tests passed.  But
  68           ;; since the shell script only `touch'es it, we can actually create
  69           ;; it ahead of time -- as long as we're certain that tests truly
  70           ;; passed, hence the check for SOFT.
  71           (when soft
  72             (with-open-file (s #p"SYS:CONTRIB;SB-INTROSPECT;TEST-PASSED"
  73                                :direction :output)
  74               (dolist (pend pending)
  75                 (format s "Expected failure: ~A~%" pend))))
  76           (warn "ignoring expected failures in test-op"))
  77         (unless soft
  78           (error "test-op failed with unexpected failures"))))))