179 lines
5.4 KiB
Scheme
179 lines
5.4 KiB
Scheme
|
|
(load-relative "loadtest.ss")
|
|
|
|
(SECTION 'COMMAND-LINE)
|
|
|
|
(require (lib "cmdline.ss"))
|
|
|
|
(define (r-append opt . rest)
|
|
(append opt (list (list->vector rest))))
|
|
|
|
(test '("-bye" #())
|
|
parse-command-line
|
|
"test"
|
|
#("--hi" "-bye")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "--hi")
|
|
(lambda (flag v) v)
|
|
(list "Hello" "x"))))
|
|
r-append
|
|
'("arg"))
|
|
|
|
(test '("1" "2" #("3"))
|
|
parse-command-line
|
|
"test"
|
|
#("-xi" "1" "2" "3")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "-x" "-i")
|
|
(lambda (flag v) v)
|
|
(list "x or i" "x"))))
|
|
r-append
|
|
'("arg"))
|
|
|
|
(test '(("-x" "a" "b") ("-i") #())
|
|
parse-command-line
|
|
"test"
|
|
#("-xi" "a" "b")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "-x" "-i")
|
|
list
|
|
(list "xi"))))
|
|
r-append
|
|
'("arg"))
|
|
|
|
(test '("--simple" ("-x" . "a") ("-i" . "b") #())
|
|
parse-command-line
|
|
"test"
|
|
#("--simple" "-xi" "a" "b")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "--simple") (lambda (v) v) (list "S"))
|
|
(list (list "-x" "-i")
|
|
cons
|
|
(list "xi" "v"))))
|
|
r-append
|
|
'("arg"))
|
|
|
|
(test '(("-x" "a" "c") ("-i" . "b") #("d"))
|
|
parse-command-line
|
|
"test"
|
|
#("-xi" "a" "c" "b" "d")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "-x")
|
|
(lambda (x y z) (list x y z))
|
|
(list "X" "y" "z"))
|
|
(list (list "-i")
|
|
cons
|
|
(list "i" "v"))))
|
|
r-append
|
|
'("arg"))
|
|
|
|
(define (test-end-flags v include?)
|
|
(test (list
|
|
(list->vector
|
|
(let ([l '("-xi" "--bad" "--")])
|
|
(if include?
|
|
(cons v l)
|
|
l))))
|
|
parse-command-line
|
|
"test"
|
|
(vector v "-xi" "--bad" "--")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "-x" "-i")
|
|
list
|
|
(list "xi"))))
|
|
r-append
|
|
'("arg")))
|
|
|
|
(test-end-flags "1" #t)
|
|
(test-end-flags "+" #t)
|
|
(test-end-flags "-" #t)
|
|
(test-end-flags "--" #f)
|
|
(test-end-flags "-1" #t)
|
|
(test-end-flags "+1" #t)
|
|
(test-end-flags "-1.4" #t)
|
|
(test-end-flags "+1999.0" #t)
|
|
|
|
(define (test-bad-flag v name) ; -h and -i defined
|
|
(test 'yes-it-worked
|
|
(lambda (x-ignored y-ignored)
|
|
(with-handlers ([void
|
|
(lambda (exn)
|
|
(if (regexp-match
|
|
(format "unknown flag: ~s" name)
|
|
(exn-message exn))
|
|
'yes-it-worked
|
|
exn))])
|
|
(parse-command-line
|
|
"test"
|
|
(vector name "--")
|
|
(list
|
|
(list
|
|
'multi
|
|
(list (list "-x" "-i")
|
|
list
|
|
(list "x i"))))
|
|
r-append
|
|
'("arg"))))
|
|
v name))
|
|
|
|
(test-bad-flag "--ok" "--ok")
|
|
(test-bad-flag "-xbi" "-b")
|
|
|
|
(test (void) parse-command-line "test" #() null void '("arg"))
|
|
(test (void) parse-command-line "test" #() (list (list 'once-each (list null void '("")))) void '("arg"))
|
|
(test (void) parse-command-line "test" #() (list (list 'once-any (list null void '("")))) void '("arg"))
|
|
(test (void) parse-command-line "test" #() (list (list 'multi (list null void '("")))) void '("arg"))
|
|
(test (void) parse-command-line "test" #() (list (list 'multi)) void '("arg"))
|
|
|
|
(test "2" parse-command-line "test" #("1" "2") null (lambda (a b c) c) '("b" "c"))
|
|
|
|
(err/rt-test (parse-command-line 'test #() null void '("arg")))
|
|
(err/rt-test (parse-command-line "test" 9 null void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list 0) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'malti)) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list 0 void '("")))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list 0) void '("")))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list "hi") void '("")))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list "--") void '("")))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list "-xi") void '("")))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list "-x") (lambda () null) '("")))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list "--xi") void ""))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() (list (list 'multi (list (list "--xi") void '("" a)))) void '("arg")))
|
|
(err/rt-test (parse-command-line "test" #() null (lambda () null) null))
|
|
|
|
(err/rt-test (parse-command-line "test" #() null (lambda (x y) null) null) exn:fail?)
|
|
|
|
(test (void) 'cmdline (command-line "something" #("-ab")
|
|
(once-each
|
|
[("-a") "ok" 5]
|
|
[("-b" "--more") "Help" 7])))
|
|
|
|
(syntax-test #'(command-line))
|
|
(syntax-test #'(command-line "hello"))
|
|
(err/rt-test (command-line 'hello #("ok")))
|
|
(syntax-test #'(command-line "hello" #("ok") (bad)))
|
|
(syntax-test #'(command-line "hello" #("ok") (once-any ())))
|
|
(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok"))))
|
|
(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" "the ok flag"))))
|
|
(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" a "the ok flag"))))
|
|
(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" (a) "the ok flag"))))
|
|
(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" a "the ok flag") ())))
|
|
(syntax-test #'(command-line "hello" #("ok") (args 'done) (once-any ("-ok" a "the ok flag" 7))))
|
|
(syntax-test #'(command-line "hello" #("ok") (args (ok) 'done) (once-any ("-ok" a "the ok flag" 7))))
|
|
(syntax-test #'(command-line "hello" #("ok") (=> 'done) (once-any ("-ok" a "the ok flag" 7))))
|
|
(syntax-test #'(command-line "hello" #("ok") (=> 1 2 3 4) (once-any ("-ok" a "the ok flag" 7))))
|
|
|
|
(report-errs)
|