This commit was manufactured by cvs2svn to create branch

'branch_release-1-6'.

test-suite/tests/getopt-long.test

@@ -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