[PATCH] SRFI-37 bugfix

[Ludovic Courtès]

Hi,

I'm considering the attached SRFI-37 fix that allows short names of
argument-less options to be actually used.

Stephen: OK to apply?

Thanks,
Ludovic.

Index: srfi/srfi-37.scm
===================================================================
RCS file: /sources/guile/guile/guile-core/srfi/srfi-37.scm,v
retrieving revision 1.2.2.2
diff -u -r1.2.2.2 srfi-37.scm
--- srfi/srfi-37.scm    18 Jul 2007 21:39:24 -0000      1.2.2.2
+++ srfi/srfi-37.scm    6 Mar 2008 10:50:04 -0000
@@ -1,6 +1,6 @@
 ;;; srfi-37.scm --- args-fold
 
-;;     Copyright (C) 2007 Free Software Foundation, Inc.
+;;     Copyright (C) 2007, 2008 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
@@ -151,7 +151,9 @@
     ;; followed by the remaining short options in (car ARGS).
     (define (short-option position)
       (if (>= position (string-length (car args)))
-         (next-arg)
+          (begin
+            (set! args (cdr args))
+            (next-arg))
          (let* ((opt-name (string-ref (car args) position))
                 (option-here (hash-ref lookup opt-name)))
            (cond ((not option-here)
Index: test-suite/tests/srfi-37.test
===================================================================
RCS file: /sources/guile/guile/guile-core/test-suite/tests/srfi-37.test,v
retrieving revision 1.1.2.2
diff -u -r1.1.2.2 srfi-37.test
--- test-suite/tests/srfi-37.test       18 Jul 2007 21:39:24 -0000      1.1.2.2
+++ test-suite/tests/srfi-37.test       6 Mar 2008 10:50:04 -0000
@@ -1,6 +1,6 @@
 ;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*-
 ;;;;
-;;;;   Copyright (C) 2007 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2007, 2008 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -94,4 +94,16 @@
                         (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)
+                        '()))))
+
 )