backward-interface.lisp 9.52 KB
Newer Older
1
2
3
;;;; -------------------------------------------------------------------------
;;; Backward-compatible interfaces

4
(uiop/package:define-package :asdf/backward-interface
5
  (:recycle :asdf/backward-interface :asdf)
6
  (:use :uiop/common-lisp :uiop :asdf/upgrade
7
   :asdf/component :asdf/system :asdf/find-system :asdf/operation :asdf/action
8
   :asdf/lisp-action :asdf/plan :asdf/operate :asdf/output-translations)
9
10
  (:export
   #:*asdf-verbose*
11
   #:operation-error #:compile-error #:compile-failed #:compile-warned
12
   #:error-component #:error-operation #:traverse
13
14
   #:component-load-dependencies
   #:enable-asdf-binary-locations-compatibility
15
   #:operation-on-failure #:operation-on-warnings #:on-failure #:on-warnings
16
   #:component-property
17
   #:run-shell-command
18
19
   #:system-definition-pathname
   #:explain))
20
21
(in-package :asdf/backward-interface)

22
(with-upgradability ()
23
24
25
26
  ;; These conditions from ASDF 1 and 2 are used by many packages in Quicklisp;
  ;; but ASDF3 replaced them with somewhat different variants of uiop:compile-condition
  ;; that do not involve ASDF actions.
  ;; TODO: find the offenders and stop them.
27
28
29
30
31
  (define-condition operation-error (error) ;; Bad, backward-compatible name
    ;; Used by SBCL, cffi-tests, clsql-mysql, clsql-uffi, qt, elephant, uffi-tests, sb-grovel
    ((component :reader error-component :initarg :component)
     (operation :reader error-operation :initarg :operation))
    (:report (lambda (c s)
32
33
               (format s (compatfmt "~@<~A while invoking ~A on ~A~@:>")
                       (type-of c) (error-operation c) (error-component c)))))
34
35
36
37
38
  (define-condition compile-error (operation-error) ())
  (define-condition compile-failed (compile-error) ())
  (define-condition compile-warned (compile-error) ())

  (defun component-load-dependencies (component)
39
    "DEPRECATED. Please use COMPONENT-SIDEWAY-DEPENDENCIES instead."
40
    ;; Old deprecated name for the same thing. Please update your software.
41
    (component-sideway-dependencies component))
42

43
44
  ;; These old interfaces from ASDF1 have never been very meaningful
  ;; but are still used in obscure places.
45
46
47
48
49
50
51
52
  (defgeneric operation-on-warnings (operation)
    (:documentation "DEPRECATED. Please use UIOP:*COMPILE-FILE-WARNINGS-BEHAVIOUR* instead."))
  (defgeneric operation-on-failure (operation)
    (:documentation "DEPRECATED. Please use UIOP:*COMPILE-FILE-FAILURE-BEHAVIOUR* instead."))
  (defgeneric (setf operation-on-warnings) (x operation)
    (:documentation "DEPRECATED. Please SETF UIOP:*COMPILE-FILE-WARNINGS-BEHAVIOUR* instead."))
  (defgeneric (setf operation-on-failure) (x operation)
    (:documentation "DEPRECATED. Please SETF UIOP:*COMPILE-FILE-FAILURE-BEHAVIOUR* instead."))
53
  (defmethod operation-on-warnings ((o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
54
    *compile-file-warnings-behaviour*)
55
  (defmethod operation-on-failure ((o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
56
    *compile-file-failure-behaviour*)
57
  (defmethod (setf operation-on-warnings) (x (o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
58
    (setf *compile-file-warnings-behaviour* x))
59
  (defmethod (setf operation-on-failure) (x (o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
60
    (setf *compile-file-failure-behaviour* x))
61
62
63
64
65

  (defun system-definition-pathname (x)
    ;; As of 2.014.8, we mean to make this function obsolete,
    ;; but that won't happen until all clients have been updated.
    ;;(cerror "Use ASDF:SYSTEM-SOURCE-FILE instead"
66
67
68
69
70
    "DEPRECATED. This function used to expose ASDF internals with subtle
differences with respect to user expectations, that have been refactored
away since. We recommend you use ASDF:SYSTEM-SOURCE-FILE instead for a
mostly compatible replacement that we're supporting, or even
ASDF:SYSTEM-SOURCE-DIRECTORY or ASDF:SYSTEM-RELATIVE-PATHNAME
71
if that's whay you mean." ;;)
72
73
    (system-source-file x))

74
75
76

  ;; TRAVERSE is the function used to compute a plan in ASDF 1 and 2.
  ;; It was never officially exposed but some people still used it.
77
  (defgeneric traverse (operation component &key &allow-other-keys)
78
79
80
81
82
83
84
85
86
87
    (:documentation
     "Generate and return a plan for performing OPERATION on COMPONENT.

The plan returned is a list of dotted-pairs. Each pair is the CONS
of ASDF operation object and a COMPONENT object. The pairs will be
processed in order by OPERATE."))
  (define-convenience-action-methods traverse (operation component &key))

  (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
    (plan-actions (apply 'make-plan plan-class o c keys))))
88
89
90


;;;; ASDF-Binary-Locations compatibility
91
;; This remains supported for legacy user, but not recommended for new users.
92
;; We suspect there are no more legacy users in 2016.
93
94
95
96
97
98
99
(with-upgradability ()
  (defun enable-asdf-binary-locations-compatibility
      (&key
       (centralize-lisp-binaries nil)
       (default-toplevel-directory
        (subpathname (user-homedir-pathname) ".fasls/")) ;; Use ".cache/common-lisp/" instead ???
       (include-per-user-information nil)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
100
       (map-all-source-files (or #+(or clasp clisp ecl mkcl) t nil))
101
102
103
       (source-to-target-mappings nil)
       (file-types `(,(compile-file-type)
                     "build-report"
104
105
                     #+clasp (compile-file-type :output-type :object)
                     #+ecl (compile-file-type :type :object)
106
107
108
                     #+mkcl (compile-file-type :fasl-p nil)
                     #+clisp "lib" #+sbcl "cfasl"
                     #+sbcl "sbcl-warnings" #+clozure "ccl-warnings")))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
109
    #+(or clasp clisp ecl mkcl)
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
    (when (null map-all-source-files)
      (error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on CLISP, ECL and MKCL"))
    (let* ((patterns (if map-all-source-files (list *wild-file*)
                         (loop :for type :in file-types
                               :collect (make-pathname :type type :defaults *wild-file*))))
           (destination-directory
             (if centralize-lisp-binaries
                 `(,default-toplevel-directory
                   ,@(when include-per-user-information
                       (cdr (pathname-directory (user-homedir-pathname))))
                   :implementation ,*wild-inferiors*)
                 `(:root ,*wild-inferiors* :implementation))))
      (initialize-output-translations
       `(:output-translations
         ,@source-to-target-mappings
         #+abcl (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname))
         #+abcl (#p"/___jar___file___root___/**/*.*" (,@destination-directory))
         ,@(loop :for pattern :in patterns
                 :collect `((:root ,*wild-inferiors* ,pattern)
                            (,@destination-directory ,pattern)))
         (t t)
         :ignore-inherited-configuration))))

  (defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
134
    (declare (ignore operation-class system args))
135
136
    (when (find-symbol* '#:output-files-for-system-and-operation :asdf nil)
      (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using.
137
138
139
140
141
142
ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS,
which should be easier to configure. Please stop using ASDF-BINARY-LOCATIONS,
and instead use ASDF-OUTPUT-TRANSLATIONS. See the ASDF manual for details.
In case you insist on preserving your previous A-B-L configuration, but
do not know how to achieve the same effect with A-O-T, you may use function
ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual;
143
call that function where you would otherwise have loaded and configured A-B-L."))))
144
145


146
147
;;; run-shell-command
;; WARNING! The function below is not just deprecated but also dysfunctional.
148
;; Please use asdf/run-program:run-program instead.
149
150
151
(with-upgradability ()
  (defun run-shell-command (control-string &rest args)
    "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
152
synchronously execute the result using a Bourne-compatible shell, with
153
154
155
156
output to *VERBOSE-OUT*.  Returns the shell's exit code.

PLEASE DO NOT USE.
Deprecated function, for backward-compatibility only.
157
Please use UIOP:RUN-PROGRAM instead."
158
159
    (let ((command (apply 'format nil control-string args)))
      (asdf-message "; $ ~A~%" command)
160
      (let ((exit-code
161
162
163
              (ignore-errors
               (nth-value 2 (run-program command :force-shell t :ignore-error-status t
                                                 :output *verbose-out*)))))
164
165
166
        (typecase exit-code
          ((integer 0 255) exit-code)
          (t 255))))))
167

168

169
170
(with-upgradability ()
  (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
171

172
173

;;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
174
175
176
177
178
179
180
181
182
183
184
185
186
187
(with-upgradability ()
  (defgeneric component-property (component property))
  (defgeneric (setf component-property) (new-value component property))

  (defmethod component-property ((c component) property)
    (cdr (assoc property (slot-value c 'properties) :test #'equal)))

  (defmethod (setf component-property) (new-value (c component) property)
    (let ((a (assoc property (slot-value c 'properties) :test #'equal)))
      (if a
          (setf (cdr a) new-value)
          (setf (slot-value c 'properties)
                (acons property new-value (slot-value c 'properties)))))
    new-value))
188
189
190
191


;;; This method survives from ASDF 1, but really it is superseded by action-description.
(with-upgradability ()
192
  (defgeneric explain (operation component)
193
194
195
196
197
198
199
    (:documentation "Display a message describing an action.
DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead."))
  (defmethod explain ((o operation) (c component))
    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
  (define-convenience-action-methods explain (operation component)))