1:
2:
3:
4:
5: (use gauche.test)
6:
7: (test-start "parseopt")
8: (use gauche.parseopt)
9: (test-module 'gauche.parseopt)
10:
11: (define (help) (display "Help message"))
12:
13: (define parser
14: (make-option-parser
15: (("help" => help)
16: ("a" () (format #t "a,"))
17: ("bb=s" (arg) (format #t "bb=~a," arg))
18: ("cc=ss" (arg1 arg2) (format #t "cc=(~a ~a)," arg1 arg2))
19: ("ddd=sss" args (format #t "ddd=~a," args))
20: ("eee=i" (arg) (format #t "eee=~s," arg))
21: ("ffff=si" (arg1 arg2) (format #t "ffff=(~a ~s)," arg1 arg2))
22: ("ggggg=fff" args (format #t "ggggg=~s," args))
23: ("h|hh|hhh" () (format #t "h*,"))
24: ("j:s" (arg) (format #t "j=~a," arg))
25: ("k:sss" args (format #t "k=~a," args))
26: (else (option args looper)
27: (format #t "?=~a," option)
28: (looper args))
29: )))
30:
31: (define (tester . cmdargs)
32: (lambda ()
33: (let* ((restarg '())
34: (output (with-output-to-string
35: (lambda ()
36: (set! restarg (parser cmdargs))))))
37: (cons output restarg))))
38:
39: (test "help" '("Help message")
40: (tester "-help"))
41:
42: (test "help" '("Help message")
43: (tester "--help"))
44:
45: (test "help" '("Help message" "x" "y")
46: (tester "-help" "x" "y"))
47:
48: (test "-a" '("a," "x" "y") (tester "-a" "x" "y"))
49: (test "--a" '("" "x" "-a" "y") (tester "x" "-a" "y"))
50: (test "-bb" '("bb=x," "y") (tester "-bb" "x" "y"))
51: (test "--bb" '("bb=x," "y") (tester "--bb" "x" "y"))
52: (test "-bb" '("bb=x," "y") (tester "-bb=x" "y"))
53: (test "-bb" '("bb=x," "y") (tester "-bb=x" "y"))
54: (test "-a -bb" '("a,bb=x," "y") (tester "-a" "-bb" "x" "y"))
55: (test "-bb -a" '("bb=x,a," "y") (tester "-bb" "x" "-a" "y"))
56: (test "-bb -a" '("bb=-a," "x" "y") (tester "-bb" "-a" "x" "y"))
57:
58: (test "-cc" '("bb=x,cc=(y z),") (tester "-bb" "x" "-cc" "y" "z"))
59: (test "-cc" '("cc=(y -bb)," "x" "z") (tester "-cc" "y" "-bb" "x" "z"))
60: (test "-cc" '("cc=(y -bb)," "x" "z") (tester "-cc=y" "-bb" "x" "z"))
61:
62: (test "-ddd" '("ddd=(x y z),") (tester "-ddd" "x" "y" "z"))
63: (test "-ddd" '("ddd=(x y z),") (tester "--ddd=x" "y" "z"))
64:
65: (test "-eee" '("eee=23," "x") (tester "-eee" "23" "x"))
66: (test "-eee" '("eee=23," "x") (tester "-eee" "023" "x"))
67: (test "-eee" '("eee=-23," "x") (tester "-eee" "-23" "x"))
68: (test "-eee" '("eee=23," "x") (tester "-eee" "#x17" "x"))
69: (test "-eee" '("eee=23," "x") (tester "-eee" "#o27" "x"))
70: (test "-eee" '("eee=23," "x") (tester "-eee" "#b10111" "x"))
71:
72: (test "-ffff" '("ffff=(-a -3),") (tester "--ffff" "-a" "-3"))
73: (test "-ffff" '("ffff=(-a -3),") (tester "-ffff" "-a" "-03"))
74: (test "-ffff" '("ffff=(-03 -3),") (tester "--ffff" "-03" "-03"))
75:
76: (test "-ggggg" '("ggggg=(1.0 2.0 3.0),") (tester "-ggggg" "1.0" "2.0" "3.0"))
77:
78: (test "-h" '("h*,") (tester "-h"))
79: (test "-hh" '("h*,") (tester "-hh"))
80: (test "-hhh" '("h*,") (tester "-hhh"))
81:
82: (test "-j" '("j=jj,a,") (tester "-j" "jj" "-a"))
83: (test "-j" '("j=#f,a,") (tester "-j" "-a"))
84: (test "-j" '("j=#f,") (tester "-j"))
85: (test "-k" '("k=(1 2 3),a,") (tester "-k" "1" "2" "3" "-a"))
86: (test "-k" '("k=(#f #f #f),a,") (tester "-k" "-a"))
87:
88: (test "--" '("bb=x," "-a" "-cc") (tester "-bb" "x" "--" "-a" "-cc"))
89: (test "--" '("" "-bb" "x" "--" "-a" "-cc") (tester "--" "-bb" "x" "--" "-a" "-cc"))
90:
91: (test "else" '("bb=x,?=what," "x" "y") (tester "-bb" "x" "-what" "x" "y"))
92: (test "else" '("bb=x,?=what,eee=3," "x" "y")
93: (tester "-bb" "x" "-what" "-eee" "3" "x" "y"))
94: (test "else" '("bb=x,?=what," "q" "-eee" "3" "x" "y")
95: (tester "-bb" "x" "-what=q" "-eee" "3" "x" "y"))
96:
97: (test* "let-args (foo)" 9
98: (let-args '() ((foo "foo=n" 9)) foo))
99:
100: (test* "let-args (foo)" #f
101: (let-args '() ((foo "foo=n")) foo))
102:
103: (test* "let-args (foo)" 3
104: (let-args '("--foo" "3") ((foo "foo=n" 9)) foo))
105:
106: (test* "let-args (foo)" *test-error*
107: (let-args '("--foof" "3") ((foo "foo=n" 9)) foo))
108:
109: (test* "let-args (foo)" 3
110: (let-args '("--foo" "3") ((bar "bar") (foo "foo=n" 9)) foo))
111:
112: (test* "let-args (bar)" #t
113: (let-args '("--bar") ((bar "bar") (foo "foo=n" 9)) bar))
114:
115: (test* "let-args (bar)" #t
116: (let-args '("--bar") ((foo "foo=n" 9) (bar "bar")) bar))
117:
118: (test* "let-args (bar)" #f
119: (let-args '("--foo" "3") ((foo "foo=n" 9) (bar "bar")) bar))
120:
121: (test* "let-args (baz)" '("4" 2)
122: (let-args '("--foo" "3" "--baz" "4" "2")
123: ((foo "foo=n" 9)
124: (bar "bar")
125: (baz "baz=si"))
126: baz))
127:
128: (test* "let-args (baz)" *test-error*
129: (let-args '("--foo" "3" "--baz" "4")
130: ((foo "foo=n" 9)
131: (bar "bar")
132: (baz "baz=si"))
133: baz))
134:
135: (test* "let-args (baz)" #f
136: (let-args '("--foo" "3" "--bar")
137: ((foo "foo=n" 9)
138: (bar "bar")
139: (baz "baz=si"))
140: baz))
141:
142: (test* "let-args (rest)" '("bunga" "bonga")
143: (let-args '("--foo" "3" "--bar" "bunga" "bonga")
144: ((foo "foo=n" 9)
145: (bar "bar")
146: (baz "baz=si")
147: . rest)
148: rest))
149:
150: (test* "let-args (rest)" '("bunga" "bonga")
151: (let-args '("bunga" "bonga")
152: ((foo "foo=n" 9)
153: (bar "bar")
154: (baz "baz=si")
155: . rest)
156: rest))
157:
158: (test* "let-args (rest)" '()
159: (let-args '()
160: ((foo "foo=n" 9)
161: (bar "bar")
162: (baz "baz=si")
163: . rest)
164: rest))
165:
166: (test* "let-args (else)" '("foo" ("5"))
167: (call/cc
168: (lambda (ret)
169: (let-args '("-foo" "5")
170: ((else (opt args cont) (ret (list opt args))))
171: #f))))
172:
173: (test* "let-args (else)" 5
174: (call/cc
175: (lambda (ret)
176: (let-args '("-foo" "5")
177: ((bar "bar=i")
178: (else (opt args cont) (cont (cons "-bar" args))))
179: bar))))
180:
181: (test* "let-args (callback)" 25
182: (let-args '("-foo" "5")
183: ((foo "foo=n" => (lambda (x) (* x x)))
184: (bar "bar"))
185: foo))
186:
187: (test* "let-args (callback)" #f
188: (let-args '()
189: ((foo "foo=n" => (lambda (x) (* x x)))
190: (bar "bar"))
191: foo))
192:
193: (test* "let-args (callback)" 8
194: (let-args '()
195: ((foo "foo=n" 8 => (lambda (x) (* x x)))
196: (bar "bar"))
197: foo))
198:
199: (test* "let-args (side-effect)" 5
200: (let ((boo 0))
201: (let-args '("-foo" "5")
202: ((#f "foo=n" => (lambda (x) (set! boo x)))
203: (bar "bar"))
204: boo)))
205:
206: (test* "let-args (side-effect)" 0
207: (let ((boo 0))
208: (let-args '("-bar")
209: ((#f "foo=n" => (lambda (x) (set! boo x)))
210: (#f "bar"))
211: boo)))
212:
213: (test* "let-args (scope)" 7
214: (let ((foo 7))
215: (let-args '("-foo" "6")
216: ((foo "foo=n")
217: (bar "bar=n" foo))
218: bar)))
219:
220: (test* "let-args (scope)" 8
221: (let ((x 8))
222: (let-args '("-foo")
223: ((x "x")
224: (foo "foo" => (lambda () x)))
225: foo)))
226:
227: (test* "let-args (scope)" 9
228: (let ((x 9))
229: (call/cc
230: (lambda (ret)
231: (let-args '("-foo")
232: ((x "x")
233: (else _ (ret x)))
234: 11)))))
235:
236: (test-end)