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
(cherry picked from commit ecaa6576a3)
This commit is contained in:
Matthew Flatt 2013-11-20 10:15:59 -07:00 committed by Ryan Culpepper
parent 3e7c9bcadf
commit 86a64e95d7
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]
[#:jobs jobs exact-nonnegative-integer? #f]
[#:get-target-dir get-target-dir (or/c #f (-> path-string?)) #f])
void?]{
boolean?]{
Runs @exec{raco setup} with various options:
@itemlist[
@ -709,7 +709,11 @@ Runs @exec{raco setup} with various options:
@item{@racket[get-target-dir] --- if not @racket[#f], treated as a
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}

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

@ -13,21 +13,24 @@
(prefix-in setup: setup/setup)
(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)
no-setup?
(not (member (getenv "PLT_PKG_NOSETUP") '(#f ""))))
(define installation? (eq? 'installation (current-pkg-scope)))
(setup:setup
#:make-user? (not installation?)
#:avoid-main? (not installation?)
#:collections (and setup-collects
(map (lambda (s)
(if (list? s) s (list s)))
setup-collects))
#:tidy? #t
#:make-doc-index? #t
#:jobs jobs)))
(unless (setup:setup
#:make-user? (not installation?)
#:avoid-main? (not installation?)
#:collections (and setup-collects
(map (lambda (s)
(if (list? s) s (list s)))
setup-collects))
#:tidy? #t
#:make-doc-index? #t
#:jobs jobs)
((current-pkg-error)
"packages ~a, although setup reported errors"
what))))
(define ((pkg-error cmd) . args)
(apply raise-user-error
@ -191,7 +194,7 @@
#:link-dirs? link-dirs?
(for/list ([p (in-list sources)])
(pkg-desc p a-type* name checksum #f))))))
(setup no-setup setup-collects jobs)))]
(setup "installed" no-setup setup-collects jobs)))]
;; ----------------------------------------
[update
"Update packages"
@ -246,7 +249,7 @@
#:update-implies? (not ignore-implies)
#:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs?))))
(setup no-setup setup-collects jobs)))]
(setup "updated" no-setup setup-collects jobs)))]
;; ----------------------------------------
[remove
"Remove packages"
@ -270,7 +273,7 @@
#:demote? demote
#:auto? auto
#:force? force)))
(setup no-setup setup-collects jobs)))]
(setup "removed" no-setup setup-collects jobs)))]
;; ----------------------------------------
[show
"Show information about installed packages"
@ -345,7 +348,7 @@
#:ignore-checksums? ignore-checksums
#:use-cache? (not no-cache)
#:strip (or (and source 'source) (and binary 'binary))))))
(setup no-setup setup-collects jobs)))]
(setup "migrated" no-setup setup-collects jobs)))]
;; ----------------------------------------
[create
"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
xml: added a #:insert-newlines? argument to write-xexpr
racket/contract: added channel/c
setup/setup: changed setup to return a boolean
Version 5.90.0.10
Changed serializable-struct, etc. to provide deserialized-info:...

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

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