Don't upgrade transitive dependencies by default.

This commit is contained in:
Alex Shinn 2015-05-08 00:46:39 +09:00
parent bfbb8c42fe
commit 9688f01afd
2 changed files with 34 additions and 21 deletions

View file

@ -1421,23 +1421,26 @@
(define (installed-libraries impl cfg) (define (installed-libraries impl cfg)
(delete-duplicates (delete-duplicates
(directory-fold-tree (append-map
(get-install-source-dir impl cfg) (lambda (dir)
#f #f (directory-fold-tree
(lambda (file acc) dir
(cond #f #f
((and (equal? "meta" (path-extension file)) (lambda (file acc)
(guard (exn (else #f)) (cond
(let ((pkg (call-with-input-file file read))) ((and (equal? "meta" (path-extension file))
(and (package? pkg) pkg)))) (guard (exn (else #f))
=> (lambda (pkg) (let ((pkg (call-with-input-file file read)))
(append (and (package? pkg) pkg))))
(map => (lambda (pkg)
(lambda (lib) (cons (library-name lib) pkg)) (append
(package-libraries pkg)) (map
acc))) (lambda (lib) (cons (library-name lib) pkg))
(else acc))) (package-libraries pkg))
'()) acc)))
(else acc)))
'()))
(get-install-search-dirs impl cfg))
(lambda (a b) (equal? (car a) (car b))))) (lambda (a b) (equal? (car a) (car b)))))
(define r7rs-small-libraries (define r7rs-small-libraries
@ -2020,7 +2023,9 @@
;; Choose packages for the corresponding libraries, and recursively ;; Choose packages for the corresponding libraries, and recursively
;; select uninstalled packages. ;; select uninstalled packages.
(define (expand-package-dependencies repo impl cfg lib-names) (define (expand-package-dependencies repo impl cfg lib-names)
(let ((current (installed-libraries impl cfg))) (let ((current (installed-libraries impl cfg))
(auto-upgrade-dependencies?
(conf-get cfg '(command install auto-upgrade-dependencies?))))
(let lp ((ls lib-names) (res '()) (ignored '())) (let lp ((ls lib-names) (res '()) (ignored '()))
(cond (cond
((null? ls) res) ((null? ls) res)
@ -2038,8 +2043,10 @@
(filter (filter
(lambda (pkg) (lambda (pkg)
(or (not current-version) (or (not current-version)
(version>? (package-version pkg) (and (or auto-upgrade-dependencies?
current-version))) (member (car ls) lib-names))
(version>? (package-version pkg)
current-version))))
providers))) providers)))
(cond (cond
((member (car ls) ignored) ((member (car ls) ignored)
@ -2116,7 +2123,10 @@
(let* ((repo (current-repositories cfg)) (let* ((repo (current-repositories cfg))
(impls (conf-selected-implementations cfg)) (impls (conf-selected-implementations cfg))
(impl-cfgs (map (lambda (impl) (impl-cfgs (map (lambda (impl)
(conf-for-implementation cfg impl)) (conf-extend
(conf-for-implementation cfg impl)
'((command install auto-upgrade-dependencies?)
. #t)))
impls))) impls)))
(for-each (for-each
(lambda (impl cfg) (lambda (impl cfg)

View file

@ -102,6 +102,9 @@
'((skip-tests? boolean ("skip-tests") "don't run tests even if present") '((skip-tests? boolean ("skip-tests") "don't run tests even if present")
(show-tests? boolean ("show-tests") "show test output even on success") (show-tests? boolean ("show-tests") "show test output even on success")
(install-tests? boolean ("install-tests") "install test-only libraries") (install-tests? boolean ("install-tests") "install test-only libraries")
(auto-upgrade-dependencies?
boolean ("auto-upgrade-dependencies")
"upgrade install dependencies when newer versions are available")
(use-sudo? symbol ("use-sudo") "always, never, or as-needed (default)"))) (use-sudo? symbol ("use-sudo") "always, never, or as-needed (default)")))
(define upgrade-spec (define upgrade-spec
install-spec) install-spec)