diff --git a/module/srfi/srfi-37.scm b/module/srfi/srfi-37.scm index 565b44cb9..3f654af2c 100644 --- a/module/srfi/srfi-37.scm +++ b/module/srfi/srfi-37.scm @@ -1,6 +1,6 @@ ;;; srfi-37.scm --- args-fold -;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. +;; 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 @@ -145,6 +145,9 @@ program-arguments in ARGS, as decided by the OPTIONS' (let ((result (cadr args))) (set! args (cddr args)) result)) + ((pair? args) + (set! args (cdr args)) + #f) (else #f))) ;; Interpret the short-option at index POSITION in (car ARGS), diff --git a/test-suite/tests/srfi-37.test b/test-suite/tests/srfi-37.test index 1f739c5c5..5a3975070 100644 --- a/test-suite/tests/srfi-37.test +++ b/test-suite/tests/srfi-37.test @@ -1,6 +1,6 @@ ;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*- ;;;; -;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. +;;;; 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 @@ -105,4 +105,26 @@ (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)) + )