(format "%s-autoloads" (package-desc-name pkg-desc))
(package-desc-dir pkg-desc)))
-(defun package--activate-autoloads-and-load-path (pkg-desc)
- "Load the autoloads file and add package dir to `load-path'.
-PKG-DESC is a `package-desc' object."
- (let* ((old-lp load-path)
- (pkg-dir (package-desc-dir pkg-desc))
- (pkg-dir-dir (file-name-as-directory pkg-dir)))
- (with-demoted-errors "Error loading autoloads: %s"
- (load (package--autoloads-file-name pkg-desc) nil t))
- (when (and (eq old-lp load-path)
- (not (or (member pkg-dir load-path)
- (member pkg-dir-dir load-path))))
- ;; Old packages don't add themselves to the `load-path', so we have to
- ;; do it ourselves.
- (push pkg-dir load-path))))
-
(defvar Info-directory-list)
(declare-function info-initialize "info" ())
(defvar package--quickstart-pkgs t
"If set to a list, we're computing the set of pkgs to activate.")
-(defun package--load-files-for-activation (pkg-desc reload)
- "Load files for activating a package given by PKG-DESC.
-Load the autoloads file, and ensure `load-path' is setup. If
-RELOAD is non-nil, also load all files in the package that
-correspond to previously loaded files."
- (let* ((loaded-files-list
- (when reload
- (package--list-loaded-files (package-desc-dir pkg-desc)))))
- ;; Add to load path, add autoloads, and activate the package.
- (package--activate-autoloads-and-load-path pkg-desc)
- ;; Call `load' on all files in `package-desc-dir' already present in
- ;; `load-history'. This is done so that macros in these files are updated
- ;; to their new definitions. If another package is being installed which
- ;; depends on this new definition, not doing this update would cause
- ;; compilation errors and break the installation.
- (with-demoted-errors "Error in package--load-files-for-activation: %s"
- (mapc (lambda (feature) (load feature nil t))
- ;; Skip autoloads file since we already evaluated it above.
- (remove (file-truename (package--autoloads-file-name pkg-desc))
- loaded-files-list)))))
+(defsubst package--library-stem (file)
+ (catch 'done
+ (let (result)
+ (dolist (suffix (get-load-suffixes) file)
+ (setq result (string-trim file nil suffix))
+ (unless (equal file result)
+ (throw 'done result))))))
+
+(defun package--reload-previously-loaded (pkg-desc)
+ "Force reimportation of files in PKG-DESC already present in `load-history'.
+New editions of files contain macro definitions and
+redefinitions, the overlooking of which would cause
+byte-compilation of the new package to fail."
+ (with-demoted-errors "Error in package--load-files-for-activation: %s"
+ (let* (result
+ (dir (package-desc-dir pkg-desc))
+ (load-path-sans-dir
+ (cl-remove-if (apply-partially #'string= dir)
+ (or (bound-and-true-p find-function-source-path)
+ load-path)))
+ (files (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))
+ (history (mapcar #'file-truename
+ (cl-remove-if-not #'stringp
+ (mapcar #'car load-history)))))
+ (dolist (file files)
+ (when-let ((library (package--library-stem
+ (file-relative-name file dir)))
+ (canonical (locate-library library nil load-path-sans-dir))
+ (found (member (file-truename canonical) history))
+ (recent-index (length found)))
+ (unless (equal (file-name-base library)
+ (format "%s-autoloads" (package-desc-name pkg-desc)))
+ (push (cons (expand-file-name library dir) recent-index) result))))
+ (mapc (lambda (c) (load (car c) nil t))
+ (sort result (lambda (x y) (< (cdr x) (cdr y))))))))
(defun package-activate-1 (pkg-desc &optional reload deps)
"Activate package given by PKG-DESC, even if it was already active.
(if (listp package--quickstart-pkgs)
;; We're only collecting the set of packages to activate!
(push pkg-desc package--quickstart-pkgs)
- (package--load-files-for-activation pkg-desc reload))
+ (when reload
+ (package--reload-previously-loaded pkg-desc))
+ (with-demoted-errors "Error loading autoloads: %s"
+ (load (package--autoloads-file-name pkg-desc) nil t))
+ (add-to-list 'load-path (directory-file-name pkg-dir)))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
;; Don't return nil.
t)))
-(defun package--files-load-history ()
- (delq nil
- (mapcar (lambda (x)
- (let ((f (car x)))
- (and (stringp f)
- (file-name-sans-extension (file-truename f)))))
- load-history)))
-
-(defun package--list-of-conflicts (dir history)
- (require 'find-func)
- (declare-function find-library-name "find-func" (library))
- (delq
- nil
- (mapcar
- (lambda (x) (let* ((file (file-relative-name x dir))
- ;; Previously loaded file, if any.
- (previous
- (ignore-error file-error ;"Can't find library"
- (file-name-sans-extension
- (file-truename (find-library-name file)))))
- (pos (when previous (member previous history))))
- ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
- (when pos
- (cons (file-name-sans-extension file) (length pos)))))
- (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))
-
-(defun package--list-loaded-files (dir)
- "Recursively list all files in DIR which correspond to loaded features.
-Returns the `file-name-sans-extension' of each file, relative to
-DIR, sorted by most recently loaded last."
- (let* ((history (package--files-load-history))
- (dir (file-truename dir))
- ;; List all files that have already been loaded.
- (list-of-conflicts (package--list-of-conflicts dir history)))
- ;; Turn the list of (FILENAME . POS) back into a list of features. Files in
- ;; subdirectories are returned relative to DIR (so not actually features).
- (let ((default-directory (file-name-as-directory dir)))
- (mapcar (lambda (x) (file-truename (car x)))
- (sort list-of-conflicts
- ;; Sort the files by ascending HISTORY-POSITION.
- (lambda (x y) (< (cdr x) (cdr y))))))))
-
;;;; `package-activate'
(defun package--get-activatable-pkg (pkg-name)
(package--native-compile-async new-desc))
;; After compilation, load again any files loaded by
;; `activate-1', so that we use the byte-compiled definitions.
- (package--load-files-for-activation new-desc :reload)))
+ (package--reload-previously-loaded new-desc)))
pkg-dir))
(defun package-generate-description-file (pkg-desc pkg-file)
(declare-function macro-problem-func "macro-problem" ())
(declare-function macro-problem-10-and-90 "macro-problem" ())
+(declare-function macro-builtin-func "macro-builtin" ())
+(declare-function macro-builtin-10-and-90 "macro-builtin" ())
(ert-deftest package-test-macro-compilation ()
- "Install a package which includes a dependency."
+ "\"Activation has to be done before compilation, so that if we're
+ upgrading and macros have changed we load the new definitions
+ before compiling.\" -- package.el"
(with-package-test (:basedir (ert-resource-directory))
(package-install-file (expand-file-name "macro-problem-package-1.0/"))
(require 'macro-problem)
;; `macro-problem-10-and-90' depends on an entirely new macro from `macro-aux'.
(should (equal (macro-problem-10-and-90) '(10 90)))))
+(ert-deftest package-test-macro-compilation-gz ()
+ "Built-in's can be superseded as well."
+ (with-package-test (:basedir (ert-resource-directory))
+ (let ((dir (expand-file-name "macro-builtin-package-1.0")))
+ (unwind-protect
+ (let ((load-path load-path))
+ (add-to-list 'load-path (directory-file-name dir))
+ (byte-recompile-directory dir 0 t)
+ (mapc (lambda (f) (rename-file f (concat f ".gz")))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))
+ (require 'macro-builtin)
+ (should (member (expand-file-name "macro-builtin-aux.elc" dir)
+ (mapcar #'car load-history)))
+ ;; `macro-builtin-func' uses a macro from `macro-aux'.
+ (should (equal (macro-builtin-func) '(progn a b)))
+ (package-install-file (expand-file-name "macro-builtin-package-2.0/"))
+ ;; After upgrading, `macro-builtin-func' depends on a new version
+ ;; of the macro from `macro-builtin-aux'.
+ (should (equal (macro-builtin-func) '(1 b)))
+ ;; `macro-builtin-10-and-90' depends on an entirely new macro from `macro-aux'.
+ (should (equal (macro-builtin-10-and-90) '(10 90))))
+ (mapc #'delete-file
+ (directory-files-recursively dir "\\`[^\\.].*\\.elc\\'"))
+ (mapc (lambda (f) (rename-file f (file-name-sans-extension f)))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el.gz\\'"))))))
+
(ert-deftest package-test-install-two-dependencies ()
"Install a package which includes a dependency."
(with-package-test ()