upgrade.lisp 5.25 KB
Newer Older
1
2
3
4
;;;; -------------------------------------------------------------------------
;;;; Handle upgrade as forward- and backward-compatibly as possible
;; See https://bugs.launchpad.net/asdf/+bug/485687

5
6
(asdf/package:define-package :asdf/upgrade
  (:recycle :asdf/upgrade :asdf)
7
  (:use :common-lisp :asdf/package :asdf/compatibility :asdf/utility)
8
  (:export
9
   #:upgrade-asdf #:asdf-upgrade-error #:when-upgrade
10
   #:*asdf-upgrade-already-attempted*
11
   #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
12
   #:asdf-version #:*upgraded-p*
13
14
   #:asdf-message #:*asdf-verbose* #:*verbose-out*
   ;; There will be no symbol left behind!
15
   #:intern*)
16
  (:import-from :asdf/package #:intern* #:find-symbol*))
17
18
(in-package :asdf/upgrade)

19
20
21
;; Note that this massive package destruction makes it impossible
;; to use asdf/driver on top of an old ASDF on these implementations
(eval-when (:load-toplevel :compile-toplevel :execute)
22
  #+(or clisp xcl)
23
24
25
26
  (unless (let ((vs (find-symbol* 'version-satisfies :asdf nil))
                (av (find-symbol* 'asdf-version :asdf nil)))
            (and vs av (funcall vs (funcall av) "2.26.59")))
    (if-bind (p (find-package :asdf))
27
             (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))))
28

29
30
31
32
33
;;; Special magic to detect if this is an upgrade

(eval-when (:load-toplevel :compile-toplevel :execute)
  (defvar *asdf-version* nil)
  (defvar *upgraded-p* nil)
34
35
  (defvar *asdf-verbose* nil) ; was t from 2.000 to 2.014.12.
  (defvar *verbose-out* nil)
36
  (defun* asdf-message (format-string &rest format-args)
37
    (apply 'format *verbose-out* format-string format-args)))
38

39
(eval-when (:load-toplevel :compile-toplevel :execute)
40
41
42
43
44
45
46
47
  (let* (;; For bug reporting sanity, please always bump this version when you modify this file.
         ;; Please also modify asdf.asd to reflect this change. The script bin/bump-version
         ;; can help you do these changes in synch (look at the source for documentation).
         ;; Relying on its automation, the version is now redundantly present on top of this file.
         ;; "2.345" would be an official release
         ;; "2.345.6" would be a development version in the official upstream
         ;; "2.345.0.7" would be your seventh local modification of official release 2.345
         ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
48
         (asdf-version "2.26.111")
49
         (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
50
51
52
         (existing-version *asdf-version*)
         (already-there (equal asdf-version existing-version)))
    (unless (and existing-asdf already-there)
53
54
55
56
57
58
59
      (when existing-asdf
        (asdf-message "~&; Upgrading ASDF ~@[from version ~A ~]to version ~A~%"
                      existing-version asdf-version))
      (unless already-there
        (push existing-version *upgraded-p*))
      (setf *asdf-version* asdf-version))))

60

61
62
63
64
65
66
67
;;; Upgrade interface

(defun* asdf-upgrade-error ()
  ;; Important notice for whom it concerns. The crux of the matter is that
  ;; TRAVERSE can be completely refactored, and so after the find-system returns, it's too late.
  (error "When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~
          Otherwise, when you upgrade ASDF, you must do it before you operate on any system.~%"))
68

69
(defmacro when-upgrade ((&key (upgraded-p '*upgraded-p*) when) &body body)
70
71
72
73
74
75
76
77
78
79
80
81
82
83
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (when (and ,upgraded-p ,@(when when `(,when)))
       (handler-bind ((style-warning #'muffle-warning))
         (eval '(progn ,@body))))))

(defun* asdf-version ()
  "Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.:
(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.345.67\")."
  *asdf-version*)


;;; Self-upgrade functions

84
85
(defvar *asdf-upgrade-already-attempted* nil)

86
87
88
(defvar *post-upgrade-cleanup-hook* ())
(defvar *post-upgrade-restart-hook* ())

89
(defun* cleanup-upgraded-asdf (old-version)
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
  (let ((new-version (asdf-version)))
    (unless (equal old-version new-version)
      (cond
        ((version-compatible-p new-version old-version)
         (asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%")
                       old-version new-version))
        ((version-compatible-p old-version new-version)
         (warn (compatfmt "~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%")
               old-version new-version))
        (t
         (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%")
                       old-version new-version)))
      (dolist (h (reverse *post-upgrade-cleanup-hook*))
        (funcall (ensure-function h)))
      (dolist (h *post-upgrade-restart-hook*)
        (funcall (ensure-function h)))
      t)))

(defun* upgrade-asdf ()
  "Try to upgrade of ASDF. If a different version was used, return T.
110
   We need do that before we operate on anything that may possibly depend on ASDF."
111
112
113
114
115
116
  (unless *asdf-upgrade-already-attempted*
    (setf *asdf-upgrade-already-attempted* t)
    (let ((version (asdf-version)))
      (handler-bind (((or style-warning warning) #'muffle-warning))
        (symbol-call :asdf :load-system :asdf :verbose nil))
      (cleanup-upgraded-asdf version))))