backward-interface.lisp 11.6 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 :asdf/session
7 8 9
   :asdf/component :asdf/system :asdf/system-registry :asdf/operation :asdf/action
   :asdf/lisp-action :asdf/plan :asdf/operate
   :asdf/find-system :asdf/parse-defsystem :asdf/output-translations)
10 11
  (:export
   #:*asdf-verbose*
12
   #:operation-error #:compile-error #:compile-failed #:compile-warned
13
   #:error-component #:error-operation #:traverse
14 15
   #:component-load-dependencies
   #:enable-asdf-binary-locations-compatibility
16
   #:operation-on-failure #:operation-on-warnings #:on-failure #:on-warnings
17
   #:component-property
18
   #:run-shell-command
19
   #:system-definition-pathname #:system-registered-p #:require-system
20
   #:explain))
21 22
(in-package :asdf/backward-interface)

23 24 25 26
;; NB: the warning status of these functions may have to be distinguished later,
;; as some get removed faster than the others in client code.
(with-asdf-deprecation (:style-warning "3.2")

27 28 29 30
  ;; 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.
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
  (progn
    (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)
                 (format s (compatfmt "~@<~A while invoking ~A on ~A~@:>")
                         (type-of c) (error-operation c) (error-component c)))))
    (define-condition compile-error (operation-error) ())
    (define-condition compile-failed (compile-error) ())
    (define-condition compile-warned (compile-error) ()))

  ;; In Quicklisp 2015-05, still used by lisp-executable, staple, repl-utilities, cffi
  (defun component-load-dependencies (component) ;; from ASDF 2.000 to 2.26
    "DEPRECATED. Please use COMPONENT-SIDEWAY-DEPENDENCIES instead; or better,
define your operations with proper use of SIDEWAY-OPERATION, SELFWARD-OPERATION,
or define methods on PREPARE-OP, etc."
48
    ;; Old deprecated name for the same thing. Please update your software.
49
    (component-sideway-dependencies component))
50

51 52
  ;; These old interfaces from ASDF1 have never been very meaningful
  ;; but are still used in obscure places.
53
  ;; In Quicklisp 2015-05, still used by cl-protobufs and clx.
54 55 56 57 58 59 60 61
  (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."))
62 63 64 65 66 67 68 69 70 71 72 73 74 75
  (progn
    (defmethod operation-on-warnings ((o operation))
      *compile-file-warnings-behaviour*)
    (defmethod operation-on-failure ((o operation))
      *compile-file-failure-behaviour*)
    (defmethod (setf operation-on-warnings) (x (o operation))
      (setf *compile-file-warnings-behaviour* x))
    (defmethod (setf operation-on-failure) (x (o operation))
      (setf *compile-file-failure-behaviour* x)))

  ;; Quicklisp 2015-05: Still used by SLIME's swank-asdf (!), common-lisp-stat,
  ;; js-parser, osicat, babel, staple, weblocks, cl-png, plain-odbc, autoproject,
  ;; cl-blapack, com.informatimago, cells-gtk3, asdf-dependency-grovel,
  ;; cl-glfw, cffi, jwacs, montezuma
76 77 78
  (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.
79 80 81 82 83
    "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
84
if that's whay you mean." ;;)
85 86
    (system-source-file x))

87 88
  ;; 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.
89
  (defgeneric traverse (operation component &key &allow-other-keys)
90
    (:documentation
91 92 93 94
     "DEPRECATED. Use MAKE-PLAN and PLAN-ACTIONS, or REQUIRED-COMPONENTS,
or some other supported interface instead.

Generate and return a plan for performing OPERATION on COMPONENT.
95 96 97 98

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."))
99 100
  (progn
    (define-convenience-action-methods traverse (operation component &key)))
101
  (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
102
    (plan-actions (apply 'make-plan plan-class o c keys)))
103 104


105 106 107
  ;; ASDF-Binary-Locations compatibility
  ;; This remains supported for legacy user, but not recommended for new users.
  ;; We suspect there are no more legacy users in 2016.
108 109
  (defun enable-asdf-binary-locations-compatibility
      (&key
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
         (centralize-lisp-binaries nil)
         (default-toplevel-directory
             ;; Use ".cache/common-lisp/" instead ???
             (subpathname (user-homedir-pathname) ".fasls/"))
         (include-per-user-information nil)
         (map-all-source-files (or #+(or clasp clisp ecl mkcl) t nil))
         (source-to-target-mappings nil)
         (file-types `(,(compile-file-type)
                        "build-report"
                        #+clasp (compile-file-type :output-type :object)
                        #+ecl (compile-file-type :type :object)
                        #+mkcl (compile-file-type :fasl-p nil)
                        #+clisp "lib" #+sbcl "cfasl"
                        #+sbcl "sbcl-warnings" #+clozure "ccl-warnings")))
    "DEPRECATED. Use asdf-output-translations instead."
Francois-Rene Rideau committed
125
    #+(or clasp clisp ecl mkcl)
126 127 128 129
    (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
130
                           :collect (make-pathname :type type :defaults *wild-file*))))
131
           (destination-directory
132 133 134 135 136 137
            (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))))
138 139 140 141 142 143
      (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
144 145
             :collect `((:root ,*wild-inferiors* ,pattern)
                        (,@destination-directory ,pattern)))
146 147
         (t t)
         :ignore-inherited-configuration))))
148 149 150 151 152
  (progn
    (defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
      (declare (ignore operation-class system args))
      (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.
153 154 155 156 157 158
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;
159
call that function where you would otherwise have loaded and configured A-B-L."))))
160 161


162
  ;; run-shell-command from ASDF 2, lightly fixed from ASDF 1, copied from MK-DEFSYSTEM. Die!
163
  (defun run-shell-command (control-string &rest args)
164
    "PLEASE DO NOT USE. This function is not just DEPRECATED, but also dysfunctional.
165
Please use UIOP:RUN-PROGRAM instead."
166
    #-(and ecl os-windows)
167 168
    (let ((command (apply 'format nil control-string args)))
      (asdf-message "; $ ~A~%" command)
169
      (let ((exit-code
170
             (ignore-errors
171
               (nth-value 2 (run-program command :force-shell t :ignore-error-status t
172
                                         :output *verbose-out*)))))
173 174
        (typecase exit-code
          ((integer 0 255) exit-code)
175 176
          (t 255))))
    #+(and ecl os-windows)
177
    (not-implemented-error "run-shell-command" "for ECL on Windows."))
178

179 180 181 182
  ;; HOW do we get rid of variables??? With a symbol-macro that issues a warning?
  ;; In Quicklisp 2015-05, cl-protobufs still uses it, but that should be fixed in next version.
  (progn
    (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
183

184 185 186 187
  ;; Do NOT use in new code. NOT SUPPORTED.
  ;; NB: When this goes away, remove the slot PROPERTY in COMPONENT.
  ;; In Quicklisp 2014-05, it's still used by yaclml, amazon-ecs, blackthorn-engine, cl-tidy.
  ;; See TODO for further cleanups required before to get rid of it.
188 189 190 191 192 193 194 195 196 197 198 199
  (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)))))
200
    new-value)
201 202


203
  ;; This method survives from ASDF 1, but really it is superseded by action-description.
204
  (defgeneric explain (operation component)
205
    (:documentation "Display a message describing an action.
206

207
DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead."))
208 209
  (progn
    (define-convenience-action-methods explain (operation component)))
210
  (defmethod explain ((o operation) (c component))
211
    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c))))
212 213 214 215 216 217 218 219 220

(with-asdf-deprecation (:style-warning "3.3")
  (defun system-registered-p (name)
    "DEPRECATED. Return a generalized boolean that is true if a system of given NAME was registered already.
NAME is a system designator, to be normalized by COERCE-NAME.
The value returned if true is a pair of a timestamp and a system object."
    (if-let (system (registered-system name))
      (cons (if-let (primary-system (registered-system (primary-system-name name)))
              (component-operation-time 'define-op primary-system))
221 222 223 224 225 226 227 228
            system)))

  (defun require-system (system &rest keys &key &allow-other-keys)
    "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but do not update the
system or its dependencies if it has already been loaded."
    (declare (ignore keys))
    (unless (component-loaded-p system)
      (load-system system))))