suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco setup: check package version deps and multiple module declarations

Browse Source 
The package dependency checking process was already gathering all the
reelvant information, or nearly all of it, so it's relatively cheap to
add the checks.
This commit is contained in:
Matthew Flatt 2014-05-02 10:18:35 -06:00
parent 33547d554a
commit b25e9fd0d4
2 changed files with 148 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -170,11 +170,13 @@ flags:
@item{@DFlag{avoid-main} --- refrain from any setup actions that @item{@DFlag{avoid-main} --- refrain from any setup actions that
affect the installation, as opposed to user-specific actions.} affect the installation, as opposed to user-specific actions.}
@item{@DFlag{no-pkg-deps} or @Flag{K} --- refrain from checking whether dependencies among @item{@DFlag{no-pkg-deps} or @Flag{K} --- refrain from checking
libraries are properly reflected by package-level dependency whether dependencies among libraries are properly reflected by
declarations. The check uses compiled bytecode and associated package-level dependency declarations, whether modules are declared
@filepath{.dep} files, and it checks only files are setup against by multiple packages, and whether package version dependencies are
only packages that include files that are setup.} satisfied. Dependency checking uses compiled bytecode and associated
@filepath{.dep} files, and it checks only files that are setup
against only packages that include files that are setup.}
@item{@DFlag{fix-pkg-deps} --- attempt to correct dependency @item{@DFlag{fix-pkg-deps} --- attempt to correct dependency
mismatches by adjusting package @filepath{info.rkt} files (which makes mismatches by adjusting package @filepath{info.rkt} files (which makes

197
racket/collects/setup/private/pkg-deps.rkt
View File

@ -10,7 +10,8 @@
racket/file racket/file
racket/path racket/path
setup/dirs setup/dirs
setup/doc-db) setup/doc-db
version/utils)
(provide check-package-dependencies) (provide check-package-dependencies)
@ -37,6 +38,9 @@
(define pkg-implies (make-hash)) ; for checking unused (define pkg-implies (make-hash)) ; for checking unused
(define pkg-reps (make-hash)) ; for union-find on external deps (define pkg-reps (make-hash)) ; for union-find on external deps
(define mod-pkg (make-hash)) (define mod-pkg (make-hash))
(define dup-mods (make-hash)) ; modules that are provided by multiple packages
(define pkg-version-deps (make-hash)) ; save version dependencies
(define pkg-versions (make-hash)) ; save declared versions
(define path-cache (make-hash)) (define path-cache (make-hash))
(define metadata-ns (make-base-namespace)) (define metadata-ns (make-base-namespace))
@ -75,6 +79,25 @@
(hash-set! pkg-reps rep-a-pkg rep-b-pkg)) (hash-set! pkg-reps rep-a-pkg rep-b-pkg))
rep-b-pkg) rep-b-pkg)
;; ----------------------------------------
;; Check whether another package has already declared a module:
(define (check-module-declaration mod pkg)
(let ([already-pkg (hash-ref mod-pkg mod #f)])
(when already-pkg
(setup-fprintf* (current-error-port) #f
(string-append
"module provided by multiple packages:\n"
" module: ~s\n"
" providing package: ~s\n"
" other providing package: ~s\n")
mod
pkg
already-pkg)
(hash-update! dup-mods mod
(lambda (ht)
(hash-set (hash-set ht pkg #t) already-pkg #t))
#hash()))))
;; ---------------------------------------- ;; ----------------------------------------
;; Get a package's info, returning its deps and implies: ;; Get a package's info, returning its deps and implies:
(define (get-immediate-pkg-info! pkg) (define (get-immediate-pkg-info! pkg)
@ -82,29 +105,39 @@
(unless dir (unless dir
(error 'check-dependencies "package not installed: ~s" pkg)) (error 'check-dependencies "package not installed: ~s" pkg))
;; Get package information: ;; Get package information:
(define-values (checksum mods deps+build-deps) (define-values (checksum mods deps+build-deps+vers)
(get-pkg-content (pkg-desc (if (path? dir) (path->string dir) dir) 'dir pkg #f #f) (get-pkg-content (pkg-desc (if (path? dir) (path->string dir) dir) 'dir pkg #f #f)
#:namespace metadata-ns #:namespace metadata-ns
#:extract-info (lambda (i) #:extract-info (lambda (i)
(if (and i (cons
(or (i 'deps (lambda () #f)) (if (and i
(i 'build-deps (lambda () #f)))) (or (i 'deps (lambda () #f))
(cons (i 'build-deps (lambda () #f))))
(extract-pkg-dependencies i (cons
#:build-deps? #f (extract-pkg-dependencies i
#:filter? #t) #:build-deps? #f
(extract-pkg-dependencies i #:filter? #t
#:filter? #t)) #:versions? #t)
#f)))) (extract-pkg-dependencies i
#:filter? #t
#:versions? #t))
#f)
(and i (i 'version (lambda () #f)))))))
(define vers (cdr deps+build-deps+vers))
(define deps+build-deps (car deps+build-deps+vers))
(unless deps+build-deps (unless deps+build-deps
(hash-set! skip-pkgs pkg #t) (hash-set! skip-pkgs pkg #t)
(setup-printf #f "package declares no dependencies: ~s" pkg)) (setup-printf #f "package declares no dependencies: ~s" pkg))
(define deps (if deps+build-deps (define deps+vers (if deps+build-deps
(filter-map package-source->name (cdr deps+build-deps)) (filter-map (lambda (p)
'())) (define n (package-source->name (car p)))
(and n (cons n (cadr p))))
(cdr deps+build-deps))
'()))
(define deps (map car deps+vers))
(define runtime-deps (if deps+build-deps (define runtime-deps (if deps+build-deps
(list->set (filter-map package-source->name (list->set (filter-map package-source->name
(car deps+build-deps))) (map car (car deps+build-deps))))
(set))) (set)))
(define implies (define implies
(list->set (let ([i (get-info/full dir #:namespace metadata-ns)]) (list->set (let ([i (get-info/full dir #:namespace metadata-ns)])
@ -123,19 +156,25 @@
pkg pkg
i)))) i))))
(for ([mod (in-list mods)]) (for ([mod (in-list mods)])
(check-module-declaration mod pkg)
(hash-set! mod-pkg mod pkg)) (hash-set! mod-pkg mod pkg))
;; Save immediate dependencies, initialize external dependencies: ;; Save immediate dependencies, initialize external dependencies:
(hash-set! pkg-reps pkg pkg) (hash-set! pkg-reps pkg pkg)
(hash-set! pkg-immediate-deps pkg (list (hash-set! pkg-immediate-deps pkg (list
(set-add runtime-deps (set-add runtime-deps
pkg) pkg)
(set-add (list->set deps) (set-add (list->set deps)
pkg))) pkg)))
(hash-set! pkg-version-deps pkg (for/list ([d (in-list deps+vers)]
#:when (cdr d))
d))
(hash-set! pkg-external-deps pkg (set-add (set-intersect (hash-set! pkg-external-deps pkg (set-add (set-intersect
implies implies
(set-add runtime-deps (set-add runtime-deps
'core)) 'core))
pkg)) pkg))
(when vers
(hash-set! pkg-versions pkg vers))
(when check-unused? (when check-unused?
(hash-set! pkg-implies pkg implies)) (hash-set! pkg-implies pkg implies))
(values deps implies)) (values deps implies))
@ -402,6 +441,27 @@
;; Treat all (direct) documentation links as 'build mode: ;; Treat all (direct) documentation links as 'build mode:
(register-or-check-docs #t pkg path coll-main?)))) (register-or-check-docs #t pkg path coll-main?))))
;; check version dependencies:
(hash-set! pkg-versions "racket" (version))
(define bad-version-dependencies
(for*/fold ([ht #hash()]) ([(pkg deps) (in-hash pkg-version-deps)]
[d (in-list deps)])
(define dep-pkg (car d))
(define dep-vers (cdr d))
(define decl-vers (hash-ref pkg-versions dep-pkg "1.0"))
(cond
[(version<? decl-vers dep-vers)
(setup-fprintf* (current-error-port) #f
(string-append
"package depends on newer version:\n"
" package: ~s\n"
" depends on package: ~s\n"
" depends on version: ~s\n"
" current package version: ~s")
pkg dep-pkg dep-vers decl-vers)
(hash-update ht pkg (lambda (l) (cons d l)) null)]
[else ht])))
(when check-unused? (when check-unused?
(for ([(pkg actuals) (in-hash pkg-actual-deps)]) (for ([(pkg actuals) (in-hash pkg-actual-deps)])
(define availables (hash-ref pkg-internal-deps pkg)) (define availables (hash-ref pkg-internal-deps pkg))
@ -444,47 +504,72 @@
(if (= (hash-count unused) 1) "" "s"))))) (if (= (hash-count unused) 1) "" "s")))))
;; Report result summary and (optionally) repair: ;; Report result summary and (optionally) repair:
(unless (zero? (hash-count missing)) (define all-ok? (and (zero? (hash-count missing))
(setup-fprintf (current-error-port) #f (zero? (hash-count dup-mods))
"--- summary of missing dependencies ---")) (zero? (hash-count bad-version-dependencies))))
(for ([pkg (in-list (sort (hash-keys missing) string<?))]) (unless all-ok?
(define pkgs (hash-ref missing pkg)) (setup-fprintf (current-error-port) #f
(define modes '(run build)) "--- summary of package problems ---")
(define pkgss (for/list ([mode modes]) (for ([(pkg deps) (in-hash bad-version-dependencies)])
(sort (setup-fprintf* (current-error-port) #f
(for/list ([(pkg pkg-mode) (in-hash pkgs)] (string-append
#:when (eq? mode pkg-mode)) "package depends on newer version:\n"
(if (eq? pkg 'core) " package: ~s\n"
core-pkg " needed package versions:~a")
pkg)) pkg
string<?))) (apply
(apply setup-fprintf* (current-error-port) #f string-append
(apply (for/list ([dep (in-list deps)])
string-append (format "\n ~s version ~s" (car dep) (cdr dep))))))
"undeclared dependency detected\n" (for ([pkg (in-list (sort (hash-keys missing) string<?))])
" for package: ~s" (define pkgs (hash-ref missing pkg))
(for/list ([pkgs (in-list pkgss)] (define modes '(run build))
[mode (in-list modes)] (define pkgss (for/list ([mode modes])
#:when (pair? pkgs)) (sort
(format "\n on package~a~a:~~a" (for/list ([(pkg pkg-mode) (in-hash pkgs)]
(if (null? (cdr pkgs)) "" "s") #:when (eq? mode pkg-mode))
(case mode (if (eq? pkg 'core)
[(run) ""] core-pkg
[(build) " for build"])))) pkg))
pkg string<?)))
(for/list ([pkgs (in-list pkgss)] (apply setup-fprintf* (current-error-port) #f
[mode (in-list modes)]
#:when (pair? pkgs))
(apply (apply
string-append string-append
(for/list ([k (in-list pkgs)]) "undeclared dependency detected\n"
(format "\n ~s" k))))) " for package: ~s"
(when fix? (for/list ([pkgs (in-list pkgss)]
(define info-path (build-path (pkg-directory pkg) "info.rkt")) [mode (in-list modes)]
(setup-printf #f "repairing ~s..." info-path) #:when (pair? pkgs))
(fix-info-deps-definition info-path 'deps (car pkgss)) (format "\n on package~a~a:~~a"
(fix-info-deps-definition info-path 'build-deps (cadr pkgss)))) (if (null? (cdr pkgs)) "" "s")
(zero? (hash-count missing))) (case mode
[(run) ""]
[(build) " for build"]))))
pkg
(for/list ([pkgs (in-list pkgss)]
[mode (in-list modes)]
#:when (pair? pkgs))
(apply
string-append
(for/list ([k (in-list pkgs)])
(format "\n ~s" k)))))
(when fix?
(define info-path (build-path (pkg-directory pkg) "info.rkt"))
(setup-printf #f "repairing ~s..." info-path)
(fix-info-deps-definition info-path 'deps (car pkgss))
(fix-info-deps-definition info-path 'build-deps (cadr pkgss))))
(for ([(mod pkgs) (in-hash dup-mods)])
(setup-fprintf* (current-error-port) #f
(string-append
"module provided by multiple packages:\n"
" module: ~s\n"
" providing packages:~a")
mod
(apply
string-append
(for/list ([pkg (hash-keys pkgs)])
(format "\n ~s" pkg))))))
all-ok?)
(define (fix-info-deps-definition info-path deps-id pkgs) (define (fix-info-deps-definition info-path deps-id pkgs)
(unless (null? pkgs) (unless (null? pkgs)