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

fix raco pkg show --rx on bad patterns

Browse Source 
Fix error reporting so it's not an internal error. Also,
report errors before printing a scope, and update the docs
for earlier changes.

Closes #1251
This commit is contained in:
Matthew Flatt 2016-04-08 18:55:57 -06:00
parent 13ebd0e1c8
commit c0bbfe8237
4 changed files with 45 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -399,19 +399,32 @@ The @racket[name] parameter is the name of the new package.
@defproc[(pkg-show [indent string?]
[pkgs-or-patterns (or/c #f (listof string?))]
[#:prefix-line prefix-line (or/c #f string?) #f]
[#:auto? auto? boolean? #f]
[#:rx? rx? boolean? #f]
[#:long? long? boolean? #f]
[#:full-checksum? full-checksum? boolean? #f]
[#:directory show-dir? boolean? #f])
void?]{
Implements @racket[pkg-show-command] for a single package scope,
printing to the current output port. See also
printing to the current output port. If @racket[prefix-line]s is not
@racket[#f], it is printed before the output. See also
@racket[installed-pkg-names] and @racket[installed-pkg-table].
If @racket[pkgs-or-patterns] is @racket[#f], then information is shown
for all installed packages, otherwise only matching packages are shown.
In @racket[rx?] is true, then elements of @racket[pkgs-or-patterns]
are treated as regular expression patterns, otherwise they are treated
as package names.
The package lock must be held to allow reads; see
@racket[with-pkg-lock/read-only].
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:long?] argument.}]}
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:long?] argument.}
#:changed "6.1.1.6" @elem{Added the @racket[#:full-checksum?] and @racket[#:rx?] arguments.}
#:changed "6.5.0.1" @elem{Added the @racket[#:prefix-line] argument.}]}
@defproc[(pkg-migrate [from-version string?]

11
racket/collects/pkg/lib.rkt
View File

@ -134,11 +134,12 @@
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-show
(->* (string? (or/c #f (listof string?)))
(#:directory? boolean?
#:long? boolean?
#:auto? boolean?
#:full-checksum? boolean?
#:rx? boolean?)
(#:prefix-line (or/c #f string?)
#:directory? boolean?
#:long? boolean?
#:auto? boolean?
#:full-checksum? boolean?
#:rx? boolean?)
void?)]
[pkg-install
(->* ((listof pkg-desc?))

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

@ -395,7 +395,7 @@
[#:bool all ("-a") "Show auto-installed packages, too"]
[#:bool long ("-l") "Show full column content"]
[#:bool full-checksum () "Show the full checksum"]
[#:bool rx () "Treat <pkgs> as regular expressions"]
[#:bool rx () "Treat <pkg>s as regular expressions"]
[#:bool dir ("-d") "Show the directory where the package is installed"]
#:once-any
scope-flags ...
@ -420,17 +420,19 @@
(simple-form-path d)))))
'(user)))])
(when (or (equal? mode only-mode) (not only-mode))
(unless only-mode
(printf "~a\n" (case mode
[(installation) "Installation-wide:"]
[(user) (format "User-specific for installation ~s:"
(or version (get-installation-name)))]
[else (format "~a:" mode)])))
(define prefix-line
(and (not only-mode)
(case mode
[(installation) "Installation-wide:"]
[(user) (format "User-specific for installation ~s:"
(or version (get-installation-name)))]
[else (format "~a:" mode)])))
(parameterize ([current-pkg-scope mode]
[current-pkg-error (pkg-error 'show)]
[current-pkg-scope-version (or version (get-installation-name))])
(with-pkg-lock/read-only
(pkg-show (if only-mode "" " ") pkgs*
#:prefix-line prefix-line
#:auto? all
#:long? long
#:rx? rx

20
racket/collects/pkg/private/show.rkt
View File

@ -6,26 +6,34 @@
racket/path
"../path.rkt"
"dirs.rkt"
"pkg-db.rkt")
"pkg-db.rkt"
"print.rkt")
(provide pkg-show)
(define (pkg-show indent only-pkgs
#:prefix-line [prefix-line #f]
#:directory? [dir? #f]
#:auto? [show-auto? #f]
#:full-checksum? [full-checksum #f]
#:long? [long? #t]
#:rx? [rx #f]
#:rx? [rx? #f]
#:name [name 'pkg-show])
(when (and rx (not only-pkgs))
(raise-user-error name "regular expression flag does not make sense without package names"))
(when rx?
(when (not only-pkgs)
(pkg-error "regular-expression mode requires at least one pattern"))
(for ([str (in-list only-pkgs)])
(regexp str (lambda (s)
(pkg-error (~a "bad regular-expression pattern;\n"
" " s "\n"
" in: " str))))))
(define db (read-pkg-db))
(define pkgs (sort (hash-keys db) string-ci<=?))
(define auto-shown? #f)
(define to-show
(for/list ([pkg (in-list pkgs)]
#:unless (and only-pkgs
(not (memf (λ (v) (if rx (regexp-match? v pkg) (equal? v pkg)))
(not (memf (λ (v) (if rx? (regexp-match? v pkg) (equal? v pkg)))
only-pkgs)))
#:when (or show-auto? only-pkgs
(not (pkg-info-auto? (hash-ref db pkg)))))
@ -59,6 +67,8 @@
(~s p)
(~a p))))
empty))))
(when prefix-line
(printf "~a\n" prefix-line))
(if (null? to-show)
(printf " [none]\n")
(let* ([col-headers (list* (format "~aPackage~a"