mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

SRFI-37: Fix infinite loop when processing short option with no required arg.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2013-03-25 23:25:57 +01:00
parent 5bb40f9df0
commit 59b0f9d763
2 changed files with 27 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/srfi/srfi-37.scm
View file

@ -1,6 +1,6 @@
;;; srfi-37.scm --- args-fold ;;; 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 ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; 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))) (let ((result (cadr args)))
(set! args (cddr args)) (set! args (cddr args))
result)) result))
((pair? args)
(set! args (cdr args))
#f)
(else #f))) (else #f)))
;; Interpret the short-option at index POSITION in (car ARGS), ;; Interpret the short-option at index POSITION in (car ARGS),

24
test-suite/tests/srfi-37.test
View file

@ -1,6 +1,6 @@
;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -105,4 +105,26 @@
(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))
) )