From 59b0f9d7635ea7e272e2976ab69764a570d7f6ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 25 Mar 2013 23:25:57 +0100
Subject: [PATCH] SRFI-37: Fix infinite loop when processing short option with
 no required arg.

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.
---
 module/srfi/srfi-37.scm       |  5 ++++-
 test-suite/tests/srfi-37.test | 24 +++++++++++++++++++++++-
 2 files changed, 27 insertions(+), 2 deletions(-)

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