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

raco pkg {install,update,...}: propagate setup exit code

Browse Source 
Also, when `raco setup` reports an error, print a message to
say that the package install/update/... completed anyway.

Merge to v6.0
This commit is contained in:
Matthew Flatt 2013-11-20 10:15:59 -07:00
parent 7e1b3c306d
commit ecaa6576a3
4 changed files with 31 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -670,7 +670,7 @@ Optional @filepath{info.rkt} fields trigger additional actions by
[#:tidy? tidy? any/c #f] [#:tidy? tidy? any/c #f]
[#:jobs jobs exact-nonnegative-integer? #f] [#:jobs jobs exact-nonnegative-integer? #f]
[#:get-target-dir get-target-dir (or/c #f (-> path-string?)) #f]) [#:get-target-dir get-target-dir (or/c #f (-> path-string?)) #f])
void?]{ boolean?]{
Runs @exec{raco setup} with various options: Runs @exec{raco setup} with various options:
@itemlist[ @itemlist[
@ -709,7 +709,11 @@ Runs @exec{raco setup} with various options:
@item{@racket[get-target-dir] --- if not @racket[#f], treated as a @item{@racket[get-target-dir] --- if not @racket[#f], treated as a
value for @sigelem[setup-option^ current-target-directory-getter]} value for @sigelem[setup-option^ current-target-directory-getter]}
]} ]
The result is @racket[#t] if @exec{raco setup} completes without error,
@racket[#f] otherwise.}
@subsection{@exec{raco setup} Unit} @subsection{@exec{raco setup} Unit}

33
racket/collects/pkg/main.rkt
View File

@ -13,21 +13,24 @@
(prefix-in setup: setup/setup) (prefix-in setup: setup/setup)
(for-syntax racket/base)) (for-syntax racket/base))
(define (setup no-setup? setup-collects jobs) (define (setup what no-setup? setup-collects jobs)
(unless (or (eq? setup-collects 'skip) (unless (or (eq? setup-collects 'skip)
no-setup? no-setup?
(not (member (getenv "PLT_PKG_NOSETUP") '(#f "")))) (not (member (getenv "PLT_PKG_NOSETUP") '(#f ""))))
(define installation? (eq? 'installation (current-pkg-scope))) (define installation? (eq? 'installation (current-pkg-scope)))
(setup:setup (unless (setup:setup
#:make-user? (not installation?) #:make-user? (not installation?)
#:avoid-main? (not installation?) #:avoid-main? (not installation?)
#:collections (and setup-collects #:collections (and setup-collects
(map (lambda (s) (map (lambda (s)
(if (list? s) s (list s))) (if (list? s) s (list s)))
setup-collects)) setup-collects))
#:tidy? #t #:tidy? #t
#:make-doc-index? #t #:make-doc-index? #t
#:jobs jobs))) #:jobs jobs)
((current-pkg-error)
"packages ~a, although setup reported errors"
what))))
(define ((pkg-error cmd) . args) (define ((pkg-error cmd) . args)
(apply raise-user-error (apply raise-user-error
@ -191,7 +194,7 @@
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
(for/list ([p (in-list sources)]) (for/list ([p (in-list sources)])
(pkg-desc p a-type* name checksum #f)))))) (pkg-desc p a-type* name checksum #f))))))
(setup no-setup setup-collects jobs)))] (setup "installed" no-setup setup-collects jobs)))]
;; ---------------------------------------- ;; ----------------------------------------
[update [update
"Update packages" "Update packages"
@ -246,7 +249,7 @@
#:update-implies? (not ignore-implies) #:update-implies? (not ignore-implies)
#:strip (or (and source 'source) (and binary 'binary)) #:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs?)))) #:link-dirs? link-dirs?))))
(setup no-setup setup-collects jobs)))] (setup "updated" no-setup setup-collects jobs)))]
;; ---------------------------------------- ;; ----------------------------------------
[remove [remove
"Remove packages" "Remove packages"
@ -270,7 +273,7 @@
#:demote? demote #:demote? demote
#:auto? auto #:auto? auto
#:force? force))) #:force? force)))
(setup no-setup setup-collects jobs)))] (setup "removed" no-setup setup-collects jobs)))]
;; ---------------------------------------- ;; ----------------------------------------
[show [show
"Show information about installed packages" "Show information about installed packages"
@ -345,7 +348,7 @@
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:use-cache? (not no-cache) #:use-cache? (not no-cache)
#:strip (or (and source 'source) (and binary 'binary)))))) #:strip (or (and source 'source) (and binary 'binary))))))
(setup no-setup setup-collects jobs)))] (setup "migrated" no-setup setup-collects jobs)))]
;; ---------------------------------------- ;; ----------------------------------------
[create [create
"Bundle package from a directory or installed package" "Bundle package from a directory or installed package"

1
racket/collects/racket/HISTORY.txt
View File

@ -2,6 +2,7 @@ Version 5.90.0.11
Added flrandom and unsafe-flrandom Added flrandom and unsafe-flrandom
xml: added a #:insert-newlines? argument to write-xexpr xml: added a #:insert-newlines? argument to write-xexpr
racket/contract: added channel/c racket/contract: added channel/c
setup/setup: changed setup to return a boolean
Version 5.90.0.10 Version 5.90.0.10
Changed serializable-struct, etc. to provide deserialized-info:... Changed serializable-struct, etc. to provide deserialized-info:...

8
racket/collects/setup/setup.rkt
View File

@ -56,5 +56,9 @@
(let/ec esc (let/ec esc
(parameterize ([exit-handler (parameterize ([exit-handler
(lambda (v) (esc (void)))]) (lambda (v) (esc (if (and (integer? v)
(setup-core))))) (<= 1 v 255))
#f
#t)))])
(setup-core)
#t))))