test-operation-classes.script 2.68 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
;;; -*- Lisp -*-

;;;---------------------------------------------------------------------------
;;; Test that we can successfully create new subclasses of OPERATION and that we
;;; can detect bad subclasses of OPERATION.
;;;---------------------------------------------------------------------------


(in-package :asdf)
(use-package :asdf-test)

(defparameter *good-classes*
  '(build-op
14
    compile-bundle-op
15
16
17
18
19
20
21
    compile-concatenated-source-op
    compile-op
    concatenate-source-op
    deliver-asd-op
    dll-op
    image-op
    lib-op
22
    load-bundle-op
23
24
    load-compiled-concatenated-source-op
    load-concatenated-source-op
25
26
    load-op
    load-source-op
27
    monolithic-compile-concatenated-source-op
28
29
    monolithic-concatenate-source-op
    monolithic-deliver-asd-op
30
31
    monolithic-dll-op
    monolithic-lib-op
32
33
    monolithic-load-compiled-concatenated-source-op
    monolithic-load-concatenated-source-op
34
    prepare-bundle-op
35
36
37
38
    prepare-op
    prepare-source-op
    program-op
    test-op)
39
40
41
  "All of these classes should be instantiable without error.")

(defclass my-unupdated-operation (operation)
42
  ())
43
44

(defclass my-good-operation (downward-operation)
45
  ())
46
47

(defclass my-incoherent-operation (downward-operation non-propagating-operation)
48
  ())
49

50
(dolist (class *good-classes*) (assert (make-operation class)))
51

52
(signals operation-definition-warning
53
         (make-operation 'my-unupdated-operation))
54

55
56
(with-expected-failure (#+gcl "GCL has trouble with CLOS?")
  (signals operation-definition-error
57
           (make-operation 'my-incoherent-operation)))
58

59
(assert (make-operation 'my-good-operation))
60
61


62
;; This test exercises the backward-compatibility mechanism of operation,
63
64
65
66
67
68
69
70
71
72
73
;; whereby traditional unqualified operations are implicitly downward and sideward
(defclass trivial-operation (operation) ())

(assert-equal
 (loop :for (o . c) :in (traverse 'trivial-operation '(:test-asdf/test-module-depend "quux"))
       :collect (cons (type-of o) (component-find-path c)))
 '((trivial-operation "test-asdf/test-module-depend" "file1")
   (trivial-operation "test-asdf/test-module-depend" "quux" "file2")
   (trivial-operation "test-asdf/test-module-depend" "quux" "file3mod" "file3")
   (trivial-operation "test-asdf/test-module-depend" "quux" "file3mod")
   (trivial-operation "test-asdf/test-module-depend" "quux")))
74
75

(operate 'trivial-operation 'test-asdf/test-module-depend)
76
77
;;; this test intended to catch a bug in operate :around method in operate.lisp,
;;; thanks to Jan Moringen [2014/08/10:rpg]
78
79
80
81
82
(operate (make-operation 'trivial-operation) 'test-asdf/test-module-depend)

;;; operations should only be made by MAKE-OPERATION, and now we enforce this.
(signals system-definition-error
    (make-instance 'load-op))