mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-06 07:30:28 +02:00
Code Activity

This commit was manufactured by cvs2svn to create branch

Browse source 
'branch_release-1-6'.
This commit is contained in:
cvs2svn 2001-08-02 10:13:04 +00:00
commit bd20255672
1 changed files with 95 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

95
test-suite/tests/getopt-long.test Normal file
View file

@ -0,0 +1,95 @@
;;;; getopt-long.test --- optional long arg processing -*- scheme -*-
;;;; Thien-Thi Nguyen <ttn@gnu.org> --- 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