mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
59b0f9d763
Fixes <http://bugs.gnu.org/13176>. * module/srfi/srfi-37.scm (args-fold)[short-option-argument]: When ARGS is a pair, always set it to its cdr. * test-suite/tests/srfi-37.test ("SRFI-37")["short option with optional argument omitted", "short option with optional argument provided"]: New tests.
130 lines
4.5 KiB
Scheme
130 lines
4.5 KiB
Scheme
;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*-
|
|
;;;;
|
|
;;;; Copyright (C) 2007, 2008, 2013 Free Software Foundation, Inc.
|
|
;;;;
|
|
;;;; This library is free software; you can redistribute it and/or
|
|
;;;; modify it under the terms of the GNU Lesser General Public
|
|
;;;; License as published by the Free Software Foundation; either
|
|
;;;; version 3 of the License, or (at your option) any later version.
|
|
;;;;
|
|
;;;; This library 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
|
|
;;;; Lesser General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Lesser General Public
|
|
;;;; License along with this library; 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)
|
|
'()))))
|
|
|
|
(pass-if-equal "short option with optional argument omitted" 'good
|
|
;; This would trigger an infinite loop in Guile up to 2.0.7.
|
|
;; See <http://bugs.gnu.org/13176>.
|
|
(args-fold '("-I")
|
|
(list (option '(#\I) #f #t
|
|
(lambda (opt name arg value)
|
|
(and (eqv? name #\I) (not arg)
|
|
'good))))
|
|
(lambda _ (error "unrecognized"))
|
|
(const #f)
|
|
#f))
|
|
|
|
(pass-if-equal "short option with optional argument provided"
|
|
"the-argument"
|
|
(args-fold '("-I" "the-argument")
|
|
(list (option '(#\I) #f #t
|
|
(lambda (opt name arg result)
|
|
(and (eqv? name #\I) arg))))
|
|
(lambda _ (error "unrecognized"))
|
|
(const #f)
|
|
#f))
|
|
|
|
)
|