;;;; 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 . (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)) )