Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Don't install libraries that are only (use-for test) by default.

Browse source
This commit is contained in:
Alex Shinn 2015-05-07 23:03:49 +09:00
parent 9b5fe665cc
commit cee04731f9
2 changed files with 30 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
lib/chibi/snow/commands.scm
View file

@ -975,11 +975,13 @@
(define (library-score lib) (define (library-score lib)
(+ (* 10 (count-in-sexp (library-name lib) keywords)) (+ (* 10 (count-in-sexp (library-name lib) keywords))
(count-in-sexp lib keywords) (count-in-sexp lib keywords)
(let ((use-for (assoc-get lib 'use-for))) (let ((use-for (assq 'use-for (cdr lib))))
(case (if (pair? use-for) (car use-for) use-for) (apply
((test) 0) max
((build) 10) 0
(else 100))))) (map
(lambda (x) (case x ((test) 0) ((build) 10) (else 100)))
(if (pair? use-for) (cdr use-for) (list use-for)))))))
(append-map (append-map
(lambda (x) (lambda (x)
(cond (cond
@ -1580,6 +1582,13 @@
(else (else
(create-directory* dir)))) (create-directory* dir))))
(define (should-install-library? impl cfg lib)
(let ((use-for (assq 'use-for (cdr lib))))
(or (not (and (pair? use-for)
(not (or (memq 'build use-for) (memq 'final use-for)))))
(conf-get cfg '(command install install-tests?))
(conf-get cfg '(command upgrade install-tests?)))))
(define (install-package-meta-info impl cfg pkg) (define (install-package-meta-info impl cfg pkg)
(let* ((meta-file (get-package-meta-file cfg pkg)) (let* ((meta-file (get-package-meta-file cfg pkg))
(install-dir (get-install-source-dir impl cfg)) (install-dir (get-install-source-dir impl cfg))
@ -1591,7 +1600,8 @@
(for-each (for-each
(lambda (lib) (lambda (lib)
(let ((lib-name (library-name lib))) (let ((lib-name (library-name lib)))
(if (not (equal? pkg-name (take lib-name (length pkg-name)))) (if (and (not (equal? pkg-name (take lib-name (length pkg-name))))
(should-install-library? impl cfg lib))
(let* ((lib-meta (make-path install-dir (let* ((lib-meta (make-path install-dir
(get-library-meta-file cfg lib))) (get-library-meta-file cfg lib)))
(rel-path (rel-path
@ -1654,10 +1664,11 @@
(else 'default))) (else 'default)))
(define (install-library impl cfg library dir) (define (install-library impl cfg library dir)
(let ((installer (if (should-install-library? impl cfg library)
(lookup-installer (or (conf-get cfg 'installer) (let ((installer
(installer-for-implementation impl cfg))))) (lookup-installer (or (conf-get cfg 'installer)
(installer impl cfg library dir))) (installer-for-implementation impl cfg)))))
(installer impl cfg library dir))))
;; The default builder just renames files per implementation. ;; The default builder just renames files per implementation.
;; Returns a new library object with any renames. ;; Returns a new library object with any renames.
@ -1951,12 +1962,14 @@
'())) '()))
(installed-files (installed-files
(append data-files lib-files prog-files))) (append data-files lib-files prog-files)))
(install-package-meta-info (if (pair? installed-files)
impl cfg (install-package-meta-info
`(,@(remove (lambda (x) impl cfg
(and (pair? x) (eq? 'installed-files (car x)))) `(,@(remove (lambda (x)
pkg) (and (pair? x)
(installed-files ,@installed-files)))) (eq? 'installed-files (car x))))
pkg)
(installed-files ,@installed-files)))))
(preserve)))))))) (preserve))))))))
(define (install-package-from-file repo impl cfg file) (define (install-package-from-file repo impl cfg file)

1
tools/snow-chibi
View file

@ -101,6 +101,7 @@
(define install-spec (define install-spec
'((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")
(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)