test-suite/tests/getopt-long.test

   1 ;;;; getopt-long.test --- long options processing -*- scheme -*-
   2 ;;;; Thien-Thi Nguyen <ttn@gnu.org> --- August 2001
   3 ;;;;
   4 ;;;;    Copyright (C) 2001, 2006 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (use-modules (test-suite lib)
  21              (ice-9 getopt-long)
  22              (ice-9 regex))
  23
  24 (defmacro deferr (name-frag re)
  25   (let ((name (symbol-append 'exception: name-frag)))
  26     `(define ,name (cons 'misc-error ,re))))
  27
  28 (deferr no-such-option              "^no such option")
  29 (deferr option-predicate-failed     "^option predicate failed")
  30 (deferr option-does-not-support-arg "^option does not support argument")
  31 (deferr option-must-be-specified    "^option must be specified")
  32 (deferr option-must-have-arg        "^option must be specified with argument")
  33
  34 (with-test-prefix "exported procs"
  35   (pass-if "`option-ref' defined"  (defined? 'option-ref))
  36   (pass-if "`getopt-long' defined" (defined? 'getopt-long)))
  37
  38 (with-test-prefix "specifying predicate"
  39
  40   (define (test1 . args)
  41     (getopt-long args
  42                  `((test (value #t)
  43                          (predicate ,(lambda (x)
  44                                        (string-match "^[0-9]+$" x)))))))
  45
  46   (pass-if "valid arg"
  47            (equal? (test1 "foo" "bar" "--test=123")
  48                    '((() "bar") (test . "123"))))
  49
  50   (pass-if-exception "invalid arg"
  51                      exception:option-predicate-failed
  52                      (test1 "foo" "bar" "--test=foo"))
  53
  54   (pass-if-exception "option has no arg"
  55                      exception:option-must-have-arg
  56                      (test1 "foo" "bar" "--test"))
  57
  58   )
  59
  60 (with-test-prefix "not specifying predicate"
  61
  62   (define (test2 . args)
  63     (getopt-long args `((test (value #t)))))
  64
  65   (pass-if "option has arg"
  66            (equal? (test2 "foo" "bar" "--test=foo")
  67                    '((() "bar") (test . "foo"))))
  68
  69   (pass-if "option has no arg"
  70            (equal? (test2 "foo" "bar")
  71                    '((() "bar"))))
  72
  73   )
  74
  75 (with-test-prefix "value optional"
  76
  77   (define (test3 . args)
  78     (getopt-long args '((foo (value optional) (single-char #\f))
  79                         (bar))))
  80
  81   (pass-if "long option `foo' w/ arg, long option `bar'"
  82            (equal? (test3 "prg" "--foo" "fooval" "--bar")
  83                    '((()) (bar . #t) (foo . "fooval"))))
  84
  85   (pass-if "short option `foo' w/ arg, long option `bar'"
  86            (equal? (test3 "prg" "-f" "fooval" "--bar")
  87                    '((()) (bar . #t) (foo . "fooval"))))
  88
  89   (pass-if "short option `foo', long option `bar', no args"
  90            (equal? (test3 "prg" "-f" "--bar")
  91                    '((()) (bar . #t) (foo . #t))))
  92
  93   (pass-if "long option `foo', long option `bar', no args"
  94            (equal? (test3 "prg" "--foo" "--bar")
  95                    '((()) (bar . #t) (foo . #t))))
  96
  97   (pass-if "long option `bar', short option `foo', no args"
  98            (equal? (test3 "prg" "--bar" "-f")
  99                    '((()) (foo . #t) (bar . #t))))
 100
 101   (pass-if "long option `bar', long option `foo', no args"
 102            (equal? (test3 "prg" "--bar" "--foo")
 103                    '((()) (foo . #t) (bar . #t))))
 104
 105   )
 106
 107 (with-test-prefix "option-ref"
 108
 109   (define (test4 option-arg . args)
 110     (equal? option-arg (option-ref (getopt-long
 111                                     (cons "prog" args)
 112                                     '((foo
 113                                        (value optional)
 114                                        (single-char #\f))
 115                                       (bar)))
 116                                    'foo #f)))
 117
 118   (pass-if "option-ref `--foo 4'"
 119            (test4 "4" "--foo" "4"))
 120
 121   (pass-if "option-ref `-f 4'"
 122            (test4 "4" "-f" "4"))
 123
 124   (pass-if "option-ref `-f4'"
 125            (test4 "4" "-f4"))
 126
 127   (pass-if "option-ref `--foo=4'"
 128            (test4 "4" "--foo=4"))
 129
 130   )
 131
 132 (with-test-prefix "required"
 133
 134   (define (test5 args specs)
 135     (getopt-long (cons "foo" args) specs))
 136
 137   (pass-if "not mentioned, not given"
 138            (equal? (test5 '() '())
 139                    '((()))))
 140
 141   (pass-if-exception "not mentioned, given"
 142                      exception:no-such-option
 143                      (test5 '("--req") '((something))))
 144
 145   (pass-if "not specified required, not given"
 146            (equal? (test5 '() '((req (required? #f))))
 147                    '((()))))
 148
 149   (pass-if "not specified required, given anyway"
 150            (equal? (test5 '("--req") '((req (required? #f))))
 151                    '((()) (req . #t))))
 152
 153   (pass-if "not specified required, but w/ value, given anyway w/ \"=\" val"
 154            (equal? (test5 '("--req=7") '((req (required? #f) (value #t))))
 155                    '((()) (req . "7"))))
 156
 157   (pass-if "not specified required, but w/ value, given anyway w/ non-\"=\" val"
 158            (equal? (test5 '("--req" "7") '((req (required? #f) (value #t))))
 159                    '((()) (req . "7"))))
 160
 161   (pass-if-exception "specified required, not given"
 162                      exception:option-must-be-specified
 163                      (test5 '() '((req (required? #t)))))
 164
 165   )
 166
 167 (with-test-prefix "specified no-value, given anyway"
 168
 169   (define (test6 args specs)
 170     (getopt-long (cons "foo" args) specs))
 171
 172   (pass-if-exception "using \"=\" syntax"
 173                      exception:option-does-not-support-arg
 174                      (test6 '("--maybe=yes") '((maybe))))
 175
 176   )
 177
 178 (with-test-prefix "specified arg required"
 179
 180   (define (test7 args)
 181     (getopt-long (cons "foo" args) '((hmm (value #t) (single-char #\H))
 182                                      (ignore))))
 183
 184   (pass-if "short opt, arg given"
 185            (equal? (test7 '("-H" "99"))
 186                    '((()) (hmm . "99"))))
 187
 188   (pass-if "long non-\"=\" opt, arg given"
 189            (equal? (test7 '("--hmm" "100"))
 190                    '((()) (hmm . "100"))))
 191
 192   (pass-if "long \"=\" opt, arg given"
 193            (equal? (test7 '("--hmm=101"))
 194                    '((()) (hmm . "101"))))
 195
 196   (pass-if-exception "short opt, arg not given"
 197                      exception:option-must-have-arg
 198                      (test7 '("-H")))
 199
 200   (pass-if-exception "long non-\"=\" opt, arg not given (next arg an option)"
 201                      exception:option-must-have-arg
 202                      (test7 '("--hmm" "--ignore")))
 203
 204   (pass-if-exception "long \"=\" opt, arg not given"
 205                      exception:option-must-have-arg
 206                      (test7 '("--hmm")))
 207
 208   )
 209
 210 (with-test-prefix "apples-blimps-catalexis example"
 211
 212   (define (test8 . args)
 213     (equal? (sort (getopt-long (cons "foo" args)
 214                                '((apples    (single-char #\a))
 215                                  (blimps    (single-char #\b) (value #t))
 216                                  (catalexis (single-char #\c) (value #t))))
 217                   (lambda (a b)
 218                     (cond ((null? (car a)) #t)
 219                           ((null? (car b)) #f)
 220                           (else (string<? (symbol->string (car a))
 221                                           (symbol->string (car b)))))))
 222             '((())
 223               (apples . #t)
 224               (blimps . "bang")
 225               (catalexis . "couth"))))
 226
 227   (pass-if "normal 1" (test8 "-a" "-b" "bang" "-c" "couth"))
 228   (pass-if "normal 2" (test8 "-ab" "bang" "-c" "couth"))
 229   (pass-if "normal 3" (test8 "-ac" "couth" "-b" "bang"))
 230
 231   (pass-if-exception "bad ordering causes missing option"
 232                      exception:option-must-have-arg
 233                      (test8 "-abc" "couth" "bang"))
 234
 235   )
 236
 237 (with-test-prefix "multiple occurrances"
 238
 239   (define (test9 . args)
 240     (equal? (getopt-long (cons "foo" args)
 241                          '((inc (single-char #\I) (value #t))
 242                            (foo (single-char #\f))))
 243             '((()) (inc . "2") (foo . #t) (inc . "1"))))
 244
 245   ;; terminology:
 246   ;; sf -- single-char free
 247   ;; sa -- single-char abutted
 248   ;; lf -- long free
 249   ;; la -- long abutted (using "=")
 250
 251   (pass-if "sf/sf" (test9 "-I" "1" "-f" "-I" "2"))
 252   (pass-if "sa/sa" (test9 "-I1" "-f" "-I2"))
 253   (pass-if "sf/sa" (test9 "-I" "1" "-f" "-I2"))
 254   (pass-if "sa/sf" (test9 "-I1" "-f" "-I" "2"))
 255
 256   (pass-if "lf/lf" (test9 "--inc" "1" "-f" "--inc" "2"))
 257   (pass-if "la/la" (test9 "--inc=1" "-f" "--inc=2"))
 258   (pass-if "lf/la" (test9 "--inc" "1" "-f" "--inc=2"))
 259   (pass-if "la/lf" (test9 "--inc=1" "-f" "--inc" "2"))
 260
 261   (pass-if "sf/lf" (test9 "-I" "1" "-f" "--inc" "2"))
 262   (pass-if "lf/sf" (test9 "--inc" "1" "-f" "-I" "2"))
 263   (pass-if "sf/la" (test9 "-I" "1" "-f" "--inc=2"))
 264   (pass-if "la/sf" (test9 "--inc=1" "-f" "-I" "2"))
 265
 266   (pass-if "sa/lf" (test9 "-I1" "-f" "--inc" "2"))
 267   (pass-if "lf/sa" (test9 "--inc" "1" "-f" "-I2"))
 268   (pass-if "sa/la" (test9 "-I1" "-f" "--inc=2"))
 269   (pass-if "la/sa" (test9 "--inc=1" "-f" "-I2"))
 270
 271   )
 272
 273 ;;; getopt-long.test ends here