1 ;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*-
3 ;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
5 ;;;; This library is free software; you can redistribute it and/or
6 ;;;; modify it under the terms of the GNU Lesser General Public
7 ;;;; License as published by the Free Software Foundation; either
8 ;;;; version 3 of the License, or (at your option) any later version.
10 ;;;; This library is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;;;; Lesser General Public License for more details.
15 ;;;; You should have received a copy of the GNU Lesser General Public
16 ;;;; License along with this library; if not, write to the Free Software
17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (define-module (test-srfi-37)
20 #:use-module (test-suite lib)
21 #:use-module (srfi srfi-37))
23 (with-test-prefix "SRFI-37"
25 (pass-if "empty calls with count-modified seeds"
29 (args-fold '("1" "3" "4") '()
30 (lambda (opt name arg seed seed2)
32 (lambda (op seed seed2)
33 (values (1+ seed) (+ 2 seed2)))
37 (pass-if "short opt params"
38 (let ((a-set #f) (b-set #f) (c-val #f) (d-val #f) (no-fail #t) (no-operands #t))
39 (args-fold '("-abcdoit" "-ad" "whatev")
40 (list (option '(#\a) #f #f (lambda (opt name arg)
43 (option '(#\b) #f #f (lambda (opt name arg)
46 (option '("cdoit" #\c) #f #t
47 (lambda (opt name arg)
51 (lambda (opt name arg)
54 (lambda (opt name arg) (set! no-fail #f) (values))
55 (lambda (oper) (set! no-operands #f) (values)))
56 (equal? '(#t #t "doit" "whatev" #t #t)
57 (list a-set b-set c-val d-val no-fail no-operands))))
59 (pass-if "single unrecognized long-opt"
61 (args-fold '("--fake" "-i2")
62 (list (option '(#\i) #t #f
63 (lambda (opt name arg k) k)))
64 (lambda (opt name arg k) name)
65 (lambda (operand k) #f)
68 (pass-if "long req'd/optional"
69 (equal? '(#f "bsquare" "apple")
70 (args-fold '("--x=pple" "--y=square" "--y")
71 (list (option '("x") #t #f
72 (lambda (opt name arg k)
73 (cons (string-append "a" arg) k)))
75 (lambda (opt name arg k)
77 (string-append "b" arg)
79 (lambda (opt name arg k) #f)
80 (lambda (opt name arg k) #f)
83 ;; this matches behavior of getopt_long in libc 2.4
84 (pass-if "short options absorb special markers in the next arg"
85 (let ((arg-proc (lambda (opt name arg k)
87 (equal? '((#\y . "-z") (#\x . "--") (#\z . #f))
88 (args-fold '("-zx" "--" "-y" "-z" "--")
89 (list (option '(#\x) #f #t arg-proc)
90 (option '(#\z) #f #f arg-proc)
91 (option '(#\y) #t #f arg-proc))
92 (lambda (opt name arg k) #f)
93 (lambda (opt name arg k) #f)
96 (pass-if "short options without arguments"
97 ;; In Guile 1.8.4 and earlier, using short names of argument-less options
98 ;; would lead to a stack overflow.
99 (let ((arg-proc (lambda (opt name arg k)
100 (acons name arg k))))
101 (equal? '((#\x . #f))
103 (list (option '(#\x) #f #f arg-proc))
104 (lambda (opt name arg k) #f)
105 (lambda (opt name arg k) #f)