From 62c5382b886f6a0e58fdff707fbf84eeef4bf166 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 12 Mar 2008 17:01:19 +0000 Subject: [PATCH] Fix SRFI-37 `args-fold' with short option names of argument-less options. --- NEWS | 7 ++++++- srfi/ChangeLog | 6 ++++++ srfi/srfi-37.scm | 6 ++++-- test-suite/ChangeLog | 5 +++++ test-suite/tests/srfi-37.test | 14 +++++++++++++- 5 files changed, 34 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index ea1aebf06..08aaa9088 100644 --- a/NEWS +++ b/NEWS @@ -46,6 +46,12 @@ Changes in 1.8.5 (since 1.8.4) Previously, expressions like `(match '((foo) (bar)) (((_ ...) ...) #t))' would trigger an unbound variable error for `match:andmap'. +** `(oop goops describe)' now properly provides the `describe' feature +** Fixed `args-fold' from `(srfi srfi-37)' + +Previously, parsing short option names of argument-less options would +lead to a stack overflow. + ** Fixed type-checking for the second argument of `eval' ** Fixed build issue for GNU/Linux on IA64 ** Fixed build issues on NetBSD 1.6 @@ -53,7 +59,6 @@ would trigger an unbound variable error for `match:andmap'. ** Fixed build issue with DEC/Compaq/HP's compiler ** Fixed `scm_from_complex_double' build issue on FreeBSD ** Fixed `alloca' build issue on FreeBSD 6 -** `(oop goops describe)' now properly provides the `describe' feature * Changes to the distribution diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 22ce98e16..338942562 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,9 @@ +2008-03-12 Ludovic Courtès + + * srfi-37.scm (args-fold)[short-option]: Set ARGS to `(cdr + args)' before calling `next-arg'. This fixes parsing of + argument-less options when using short names. + 2008-01-22 Neil Jerram * srfi-39.scm: Update copyright statement to LGPL. diff --git a/srfi/srfi-37.scm b/srfi/srfi-37.scm index 481789ed3..5e6d512a2 100644 --- a/srfi/srfi-37.scm +++ b/srfi/srfi-37.scm @@ -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 @@ program-arguments in ARGS, as decided by the OPTIONS' ;; 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) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index fa3f88ba3..b2ebfe248 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-03-12 Ludovic Courtès + + * tests/srfi-37.test (short options without arguments): New + test. + 2008-02-23 Neil Jerram * standalone/test-with-guile-module.c: Updated to GNU coding diff --git a/test-suite/tests/srfi-37.test b/test-suite/tests/srfi-37.test index 73647c004..d7745876d 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 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) + '())))) + )