mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +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
;; 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),

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

@ -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 <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))
)