diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test new file mode 100644 index 000000000..1d1658a09 --- /dev/null +++ b/test-suite/tests/getopt-long.test @@ -0,0 +1,95 @@ +;;;; getopt-long.test --- optional long arg processing -*- scheme -*- +;;;; Thien-Thi Nguyen --- August 2001 +;;;; +;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;;;; Boston, MA 02111-1307 USA + +(use-modules (test-suite lib) + (ice-9 getopt-long) + (ice-9 regex)) + +(define exception:option-predicate-failed + (cons 'misc-error "^option predicate failed")) + +(with-test-prefix "specifying predicate" + + (define (test1 . args) + (getopt-long args `((test (value #t) + (predicate ,(lambda (x) + (string-match "^[0-9]+$" x))))))) + + (pass-if "valid arg" + (equal? (test1 "foo" "bar" "--test=123") + '((() "bar") (test . "123")))) + + (pass-if-exception "invalid arg" + exception:option-predicate-failed + (test1 "foo" "bar" "--test=foo")) + + (pass-if-exception "option has no arg" + exception:option-predicate-failed + (test1 "foo" "bar")) + + ) + +(with-test-prefix "not specifying predicate" + + (define (test2 . args) + (getopt-long args `((test (value #t))))) + + (pass-if "option has arg" + (equal? (test2 "foo" "bar" "--test=foo") + '((() "bar") (test . "foo")))) + + (pass-if "option has no arg" + (equal? (test2 "foo" "bar") + '((() "bar")))) + + ) + +(with-test-prefix "value optional" + + (define (test3 . args) + (getopt-long args '((foo (value optional) (single-char #\f)) + (bar)))) + + (pass-if "long option `foo' w/ arg, long option `bar'" + (equal? (test3 "prg" "--foo" "fooval" "--bar") + '((()) (bar . #t) (foo . "fooval")))) + + (pass-if "short option `foo' w/ arg, long option `bar'" + (equal? (test3 "prg" "-f" "fooval" "--bar") + '((()) (bar . #t) (foo . "fooval")))) + + (pass-if "short option `foo', long option `bar', no args" + (equal? (test3 "prg" "-f" "--bar") + '((()) (bar . #t) (foo . #t)))) + + (pass-if "long option `foo', long option `bar', no args" + (equal? (test3 "prg" "--foo" "--bar") + '((()) (bar . #t) (foo . #t)))) + + (pass-if "long option `bar', short option `foo', no args" + (equal? (test3 "prg" "--bar" "-f") + '((()) (foo . #t) (bar . #t)))) + + (pass-if "long option `bar', long option `foo', no args" + (equal? (test3 "prg" "--bar" "--foo") + '((()) (foo . #t) (bar . #t)))) + ) + +;;; getopt-long.test ends here