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

raco setup: exit with error status on failed pkg dependency check

Browse Source 
Also, clean up printing of check errors to prefix each line with
`raco setup' (like everything else).
This commit is contained in:
Matthew Flatt 2013-07-10 13:18:52 -06:00
parent 32b0064b56
commit da3ac6159d
2 changed files with 58 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,6 +32,15 @@
(define mod-pkg (make-hash))
(define path-cache (make-hash))
(define metadata-ns (make-base-namespace))
;; ----------------------------------------
;; printinf helpers:
(define (setup-printf* task s . args)
(for ([s (string-split (apply format s args) "\n")])
(setup-printf task s)))
(define (setup-fprintf* o task s . args)
(for ([s (string-split (apply format s args) "\n")])
(setup-fprintf o task s)))
;; ----------------------------------------
;; Find the canonical representative for a set of external dependencies:
@ -91,13 +100,13 @@
(for ([i (in-set implies)])
(unless (eq? i 'core)
(unless (set-member? runtime-deps i)
(setup-fprintf (current-error-port) #f
(string-append
"implied package is not declared as a dependency:\n"
" in package: ~s\n"
" implied package: ~s\n")
pkg
i))))
(setup-fprintf* (current-error-port) #f
(string-append
"implied package is not declared as a dependency:\n"
" in package: ~s\n"
" implied package: ~s\n")
pkg
i))))
(for ([mod (in-list mods)])
(hash-set! mod-pkg mod pkg))
;; Save immediate dependencies, initialize external dependencies:
@ -172,15 +181,15 @@
string-append
(for/list ([k (in-set s)])
(format "\n ~s" k))))
(setup-printf #f
(string-append
" declared accesses, counting `implies'\n"
" for package: ~s\n"
" packages:~a\n"
" packages for build:~a")
pkg
(make-list (car (hash-ref pkg-internal-deps pkg)))
(make-list (cadr (hash-ref pkg-internal-deps pkg)))))))
(setup-printf* #f
(string-append
" declared accesses, counting `implies'\n"
" for package: ~s\n"
" packages:~a\n"
" packages for build:~a")
pkg
(make-list (car (hash-ref pkg-internal-deps pkg)))
(make-list (cadr (hash-ref pkg-internal-deps pkg)))))))
;; ----------------------------------------
;; Check use of `mod' (in `mode') from `pkg' by file `f':
@ -206,19 +215,19 @@
(define key (list pkg src-pkg (path-replace-suffix f #"") mod))
(unless (hash-ref reported key #f)
(hash-set! reported key #t)
(setup-fprintf (current-error-port) #f
(string-append
"found undeclared dependency:\n"
" mode: ~s\n"
" for package: ~s\n"
" on package: ~s\n"
" dependent source: ~a\n"
" used module: ~s")
mode
pkg
src-pkg
f
mod)))))
(setup-fprintf* (current-error-port) #f
(string-append
"found undeclared dependency:\n"
" mode: ~s\n"
" for package: ~s\n"
" on package: ~s\n"
" dependent source: ~a\n"
" used module: ~s")
mode
pkg
src-pkg
f
mod)))))
;; For each collection, set up package info:
(for ([path (in-list paths)])
@ -307,7 +316,7 @@
core-pkg
pkg))
string<?)))
(apply setup-fprintf (current-error-port) #f
(apply setup-fprintf* (current-error-port) #f
(apply
string-append
"undeclared dependency detected\n"
@ -332,7 +341,8 @@
(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)))))
(fix-info-deps-definition info-path 'build-deps (cadr pkgss))))
(zero? (hash-count missing)))
(define (fix-info-deps-definition info-path deps-id pkgs)
(unless (null? pkgs)

32
racket/lib/collects/setup/setup-unit.rkt
View File

@ -120,6 +120,7 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define errors null)
(define exit-code 0)
(define (append-error cc desc exn out err type)
(set! errors (cons (list cc desc exn out err type) errors)))
(define (handle-error cc desc exn out err type)
@ -155,7 +156,7 @@
(eprintf "INSTALLATION FAILED.\nPress Enter to continue...\n")
(read-line))
(exit 1))
(exit 0))
(exit exit-code))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Archive Unpacking ;;
@ -1594,20 +1595,21 @@
(define (do-check-package-dependencies)
(setup-printf #f (format "--- checking package dependencies ---"))
(check-package-dependencies (map cc-path ccs-to-compile)
(map cc-collection ccs-to-compile)
;; If "test" or "scribblings" is this collection's name,
;; then it's build-mode code, otherwise it's test mode:
(let ([tests-path (string->path "tests")]
[scribblings-path (string->path "scribblings")])
(for/list ([cc (in-list ccs-to-compile)])
(if (or (member tests-path (cc-collection cc))
(member scribblings-path (cc-collection cc)))
'build
'run)))
setup-printf setup-fprintf
(fix-dependencies)
(verbose)))
(unless (check-package-dependencies (map cc-path ccs-to-compile)
(map cc-collection ccs-to-compile)
;; If "test" or "scribblings" is this collection's name,
;; then it's build-mode code, otherwise it's test mode:
(let ([tests-path (string->path "tests")]
[scribblings-path (string->path "scribblings")])
(for/list ([cc (in-list ccs-to-compile)])
(if (or (member tests-path (cc-collection cc))
(member scribblings-path (cc-collection cc)))
'build
'run)))
setup-printf setup-fprintf
(fix-dependencies)
(verbose))
(set! exit-code 1)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; setup-unit Body ;;