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

racket/cmdline: add missing checks in command-line

Browse Source 
Closes #1989
This commit is contained in:
Matthew Flatt 2018-03-14 06:21:53 -06:00
parent 145b3d840e
commit aad799f09e
2 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-test-core/tests/racket/cmdline.rktl
View File

@ -204,6 +204,16 @@
(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:args 'done #:once-any [("-ok") a 7]))
(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:args (ok) 'done #:once-any [("-ok") a "the ok flag" 7]))
;; Make sure that `command-line` check flag syntax itself
(syntax-test #'(command-line #:once-any [("-1") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("+5") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("-") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("++") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("-+") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("-xx") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("-h") "oops" (void)]))
(syntax-test #'(command-line #:once-any [("--help") "oops" (void)]))
(err/rt-test (parse-command-line "test" #("x") null (lambda () 'too-few) '("arg")))
(err/rt-test (parse-command-line "test" #("x") null (lambda (x) 'still-too-few) '("arg")))
(err/rt-test (parse-command-line "test" #("x") null (lambda (x y z) 'too-many) '("arg")))

22
racket/collects/racket/cmdline.rkt
View File

@ -49,6 +49,13 @@
[(null? lst) null]
[(keyword? (syntax-e (car lst))) lst]
[else (at-next-keyword (cdr lst))]))
(define (check-ok-flag flag)
(unless (regexp-match? #rx"^([-+][^-+]$|(--|[+][+])[^-+])" (syntax-e flag))
(serror "bad flag string" flag))
(when (regexp-match? #rx"^[-+][0-9]$" (syntax-e flag))
(serror "number flag not allowed" flag))
(when (regexp-match? #rx"^(-h|--help)$" (syntax-e flag))
(serror "pre-defined flag not allowed" flag)))
(let ([lst (syntax->list stx)])
(unless lst
(raise-syntax-error #f "bad syntax (misuse of `.')" stx))
@ -99,17 +106,22 @@
([flags
(syntax-case (car sublines) ()
[((flag ...) . rest)
(begin
(let ([flags (syntax->list #'(flag ...))])
(unless (andmap
(lambda (x) (string? (syntax-e x)))
(syntax->list #'(flag ...)))
flags)
(serror
"flag specification is not a string or sequence of strings"
#'(flag ...)))
"flag specification is not a string or sequence of strings"
(syntax-case (car sublines) ()
[(flags . rest)
#'flags])))
(for-each check-ok-flag flags)
#'(flag ...))]
[(flag . rest)
(string? (syntax-e #'flag))
#'(flag)]
(begin
(check-ok-flag #'flag)
#'(flag))]
[else
(serror "clause does not start with flags")])])
(syntax-case* (car sublines) (=>) id=?