blob: d7745876d0cb3d1a2db180df3fb022945ad98d51 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*-
;;;;
;;;; Copyright (C) 2007, 2008 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., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(define-module (test-srfi-37)
#:use-module (test-suite lib)
#:use-module (srfi srfi-37))
(with-test-prefix "SRFI-37"
(pass-if "empty calls with count-modified seeds"
(equal? (list 21 42)
(call-with-values
(lambda ()
(args-fold '("1" "3" "4") '()
(lambda (opt name arg seed seed2)
(values 1 2))
(lambda (op seed seed2)
(values (1+ seed) (+ 2 seed2)))
18 36))
list)))
(pass-if "short opt params"
(let ((a-set #f) (b-set #f) (c-val #f) (d-val #f) (no-fail #t) (no-operands #t))
(args-fold '("-abcdoit" "-ad" "whatev")
(list (option '(#\a) #f #f (lambda (opt name arg)
(set! a-set #t)
(values)))
(option '(#\b) #f #f (lambda (opt name arg)
(set! b-set #t)
(values)))
(option '("cdoit" #\c) #f #t
(lambda (opt name arg)
(set! c-val arg)
(values)))
(option '(#\d) #f #t
(lambda (opt name arg)
(set! d-val arg)
(values))))
(lambda (opt name arg) (set! no-fail #f) (values))
(lambda (oper) (set! no-operands #f) (values)))
(equal? '(#t #t "doit" "whatev" #t #t)
(list a-set b-set c-val d-val no-fail no-operands))))
(pass-if "single unrecognized long-opt"
(equal? "fake"
(args-fold '("--fake" "-i2")
(list (option '(#\i) #t #f
(lambda (opt name arg k) k)))
(lambda (opt name arg k) name)
(lambda (operand k) #f)
#f)))
(pass-if "long req'd/optional"
(equal? '(#f "bsquare" "apple")
(args-fold '("--x=pple" "--y=square" "--y")
(list (option '("x") #t #f
(lambda (opt name arg k)
(cons (string-append "a" arg) k)))
(option '("y") #f #t
(lambda (opt name arg k)
(cons (if arg
(string-append "b" arg)
#f) k))))
(lambda (opt name arg k) #f)
(lambda (opt name arg k) #f)
'())))
;; this matches behavior of getopt_long in libc 2.4
(pass-if "short options absorb special markers in the next arg"
(let ((arg-proc (lambda (opt name arg k)
(acons name arg k))))
(equal? '((#\y . "-z") (#\x . "--") (#\z . #f))
(args-fold '("-zx" "--" "-y" "-z" "--")
(list (option '(#\x) #f #t arg-proc)
(option '(#\z) #f #f arg-proc)
(option '(#\y) #t #f arg-proc))
(lambda (opt name arg k) #f)
(lambda (opt name arg k) #f)
'()))))
(pass-if "short options without arguments"
;; In Guile 1.8.4 and earlier, using short names of argument-less options
;; would lead to a stack overflow.
(let ((arg-proc (lambda (opt name arg k)
(acons name arg k))))
(equal? '((#\x . #f))
(args-fold '("-x")
(list (option '(#\x) #f #f arg-proc))
(lambda (opt name arg k) #f)
(lambda (opt name arg k) #f)
'()))))
)
|
