Diff of /contrib/sb-introspect/sb-introspect.asd [9c3a95] .. [25c176]  Maximize  Restore

  Switch to unified view

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

Get latest updates about Open Source Projects, Conferences and News.

Sign up for the SourceForge newsletter:





No, thanks