diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-05-06 14:11:16 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-05-06 14:11:16 -0400 |
commit | 5e87fcb1d7c55532cfb7163b1de68e7ddaed4201 (patch) | |
tree | b4fbd39f117e1cda1e90fa620f45bffb68ae1ab3 | |
parent | 8e102bcc97871ed6e0d2deba84fe46d9a78e9e44 (diff) | |
download | emacs-5e87fcb1d7c55532cfb7163b1de68e7ddaed4201.tar.gz |
* lisp/emacs-lisp/package.el (package-compute-transaction): Topological sort.
Add optional `seen' argument to detect and break infinite loops.
Fixes: debbugs:16994
-rw-r--r-- | lisp/ChangeLog | 19 | ||||
-rw-r--r-- | lisp/emacs-lisp/package.el | 28 |
2 files changed, 31 insertions, 16 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7a737129bb7..8e5f5f54f16 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2014-05-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/package.el (package-compute-transaction): Topological sort. + Add optional `seen' argument to detect and break infinite loops. + 2014-05-06 Eli Zaretskii <eliz@gnu.org> * emacs-lisp/find-gc.el (find-gc-unsafe, find-unsafe-funcs) @@ -6,11 +11,11 @@ 2014-05-06 Michael Albinus <michael.albinus@gmx.de> - * net/tramp-sh.el (tramp-remote-process-environment): Remove - HISTFILE and HISTSIZE; it's too late to set them here. Add - :version entry. - (tramp-open-shell): Do not let-bind `tramp-end-of-output'. Add - "HISTSIZE=/dev/null" to the shell's env arguments. Do not send + * net/tramp-sh.el (tramp-remote-process-environment): + Remove HISTFILE and HISTSIZE; it's too late to set them here. + Add :version entry. + (tramp-open-shell): Do not let-bind `tramp-end-of-output'. + Add "HISTSIZE=/dev/null" to the shell's env arguments. Do not send extra "PSx=..." commands. (tramp-maybe-open-connection): Setenv HISTFILE to /dev/null. (Bug#17295) @@ -126,8 +131,8 @@ (todo-edit-done-item--param-key-alist): New defconsts. (todo-edit-item--prompt): New variable. (todo-edit-item--next-key): New function. - (todo-key-bindings-t): Bind "e" to todo-edit-item. Remove - bindings of deleted commands. + (todo-key-bindings-t): Bind "e" to todo-edit-item. + Remove bindings of deleted commands. 2014-05-02 Leo Liu <sdl.web@gmail.com> diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7be0354992f..c194e1352ac 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -868,7 +868,7 @@ MIN-VERSION should be a version list." ;; Also check built-in packages. (package-built-in-p package min-version))) -(defun package-compute-transaction (packages requirements) +(defun package-compute-transaction (packages requirements &optional seen) "Return a list of packages to be installed, including PACKAGES. PACKAGES should be a list of `package-desc'. @@ -880,7 +880,9 @@ version of that package. This function recursively computes the requirements of the packages in REQUIREMENTS, and returns a list of all the packages that must be installed. Packages that are already installed are -not included in this list." +not included in this list. + +SEEN is used internally to detect infinite recursion." ;; FIXME: We really should use backtracking to explore the whole ;; search space (e.g. if foo require bar-1.3, and bar-1.4 requires toto-1.1 ;; whereas bar-1.3 requires toto-1.0 and the user has put a hold on toto-1.0: @@ -893,15 +895,22 @@ not included in this list." (dolist (pkg packages) (if (eq next-pkg (package-desc-name pkg)) (setq already pkg))) - (cond - (already + (when already (if (version-list-<= next-version (package-desc-version already)) - ;; Move to front, so it gets installed early enough (bug#14082). - (setq packages (cons already (delq already packages))) + ;; `next-pkg' is already in `packages', but its position there + ;; means it might be installed too late: remove it from there, so + ;; we re-add it (along with its dependencies) at an earlier place + ;; below (bug#16994). + (if (memq already seen) ;Avoid inf-loop on dependency cycles. + (message "Dependency cycle going through %S" + (package-desc-full-name already)) + (setq packages (delq already packages)) + (setq already nil)) (error "Need package `%s-%s', but only %s is being installed" next-pkg (package-version-join next-version) (package-version-join (package-desc-version already))))) - + (cond + (already nil) ((package-installed-p next-pkg next-version) nil) (t @@ -933,12 +942,13 @@ but version %s required" (t (setq found pkg-desc))))) (unless found (if problem - (error problem) + (error "%s" problem) (error "Package `%s-%s' is unavailable" next-pkg (package-version-join next-version)))) (setq packages (package-compute-transaction (cons found packages) - (package-desc-reqs found)))))))) + (package-desc-reqs found) + (cons found seen)))))))) packages) (defun package-read-from-string (str) |