backward-interface.lisp 10.4 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 15
   #:component-load-dependencies
   #:enable-asdf-binary-locations-compatibility
   #:operation-forced
16
   #:operation-on-failure #:operation-on-warnings #:on-failure #:on-warnings
17
   #:component-property
18
   #:run-shell-command
19 20
   #:system-definition-pathname
   #:explain))
21 22
(in-package :asdf/backward-interface)

23
(with-upgradability ()
24 25 26 27
  ;; 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.
28 29 30 31 32
  (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)
33 34
               (format s (compatfmt "~@<~A while invoking ~A on ~A~@:>")
                       (type-of c) (error-operation c) (error-component c)))))
35 36 37 38 39
  (define-condition compile-error (operation-error) ())
  (define-condition compile-failed (compile-error) ())
  (define-condition compile-warned (compile-error) ())

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

44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
  (defun* (operation-forced) (operation)
    "DEPRECATED. Assume it's (constantly nil) instead -- until it disappears."
    ;; This function exists for backward compatibility with swank.asd, its only user,
    ;; that still abuses it as of 2016-10-01.
    ;;
    ;; The magic PERFORM method in swank.asd only actually loads swank if it sees
    ;; that the operation was forced. But it actually fails, badly, in that case.
    ;; The correctness criterion for a build specification (which is _not_
    ;; specific to ASDF) requires that the effects of a build step must NOT depend
    ;; on whether the step was "forced" or not. Therefore it is correct that this
    ;; method should return constantly the same result. Since returning T currently
    ;; causes massive failure in SLIME, it shall be constantly NIL.
    ;; see also https://bugs.launchpad.net/asdf/+bug/1629582
    (declare (ignore operation))
    nil)
59 60 61

  ;; These old interfaces from ASDF1 have never been very meaningful
  ;; but are still used in obscure places.
62 63 64 65 66 67 68 69
  (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."))
70
  (defmethod operation-on-warnings ((o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
71
    *compile-file-warnings-behaviour*)
72
  (defmethod operation-on-failure ((o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
73
    *compile-file-failure-behaviour*)
74
  (defmethod (setf operation-on-warnings) (x (o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
75
    (setf *compile-file-warnings-behaviour* x))
76
  (defmethod (setf operation-on-failure) (x (o operation))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
77
    (setf *compile-file-failure-behaviour* x))
78 79 80 81 82

  (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"
83 84 85 86 87
    "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
88
if that's whay you mean." ;;)
89 90
    (system-source-file x))

91 92 93

  ;; 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.
94 95 96 97 98 99 100 101 102 103 104
  (defgeneric* (traverse) (operation component &key &allow-other-keys)
    (: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))))
105 106 107


;;;; ASDF-Binary-Locations compatibility
108
;; This remains supported for legacy user, but not recommended for new users.
109
;; We suspect there are no more legacy users in 2016.
110 111 112 113 114 115 116
(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
117
       (map-all-source-files (or #+(or clasp clisp ecl mkcl) t nil))
118 119 120
       (source-to-target-mappings nil)
       (file-types `(,(compile-file-type)
                     "build-report"
121 122
                     #+clasp (compile-file-type :output-type :object)
                     #+ecl (compile-file-type :type :object)
123 124 125
                     #+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
126
    #+(or clasp clisp ecl mkcl)
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
    (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
151
    (declare (ignore operation-class system args))
152 153
    (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.
154 155 156 157 158 159
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;
160
call that function where you would otherwise have loaded and configured A-B-L."))))
161 162


163 164
;;; run-shell-command
;; WARNING! The function below is not just deprecated but also dysfunctional.
165
;; Please use asdf/run-program:run-program instead.
166 167 168
(with-upgradability ()
  (defun run-shell-command (control-string &rest args)
    "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
169
synchronously execute the result using a Bourne-compatible shell, with
170 171 172 173
output to *VERBOSE-OUT*.  Returns the shell's exit code.

PLEASE DO NOT USE.
Deprecated function, for backward-compatibility only.
174
Please use UIOP:RUN-PROGRAM instead."
175 176
    (let ((command (apply 'format nil control-string args)))
      (asdf-message "; $ ~A~%" command)
177
      (let ((exit-code
178 179 180
              (ignore-errors
               (nth-value 2 (run-program command :force-shell t :ignore-error-status t
                                                 :output *verbose-out*)))))
181 182 183
        (typecase exit-code
          ((integer 0 255) exit-code)
          (t 255))))))
184

185

186 187
(with-upgradability ()
  (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
188

189 190

;;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
191 192 193 194 195 196 197 198 199 200 201 202 203 204
(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))
205 206 207 208 209 210 211 212 213 214 215 216


;;; This method survives from ASDF 1, but really it is superseded by action-description.
(with-upgradability ()
  (defgeneric* (explain) (operation component)
    (: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)))