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