mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix handling of the FLAGS argument in `fold-matches'.

Browse source 
* ice-9/regex.scm (fold-matches): If FLAGS is non-null, use
  `(car flags)', not `flags'.

* test-suite/tests/regexp.test ("fold-matches"): New test prefix.

* NEWS: Update.
This commit is contained in:
Ludovic Courtès 2008-09-25 21:07:06 +02:00
parent fb2f8886c4
commit c633310265
3 changed files with 27 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

1
NEWS
View file

@ -65,6 +65,7 @@ available: Guile is now always configured in "maintainer mode".
** `symbol->string' now returns a read-only string, as per R5RS ** `symbol->string' now returns a read-only string, as per R5RS
** Literal strings as returned by `read' are now read-only, as per R5RS ** Literal strings as returned by `read' are now read-only, as per R5RS
** Fix incorrect handling of the FLAGS argument of `fold-matches'
** `guile-config link' now prints `-L$libdir' before `-lguile' ** `guile-config link' now prints `-L$libdir' before `-lguile'
** Fix memory corruption involving GOOPS' `class-redefinition' ** Fix memory corruption involving GOOPS' `class-redefinition'
** Fix possible deadlock in `mutex-lock' ** Fix possible deadlock in `mutex-lock'

4
ice-9/regex.scm
View file

@ -1,4 +1,4 @@
;;;; Copyright (C) 1997, 1999, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; Copyright (C) 1997, 1999, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -178,7 +178,7 @@
(define (fold-matches regexp string init proc . flags) (define (fold-matches regexp string init proc . flags)
(let ((regexp (if (regexp? regexp) regexp (make-regexp regexp))) (let ((regexp (if (regexp? regexp) regexp (make-regexp regexp)))
(flags (if (null? flags) 0 flags))) (flags (if (null? flags) 0 (car flags))))
(let loop ((start 0) (let loop ((start 0)
(value init) (value init)
(abuts #f)) ; True if start abuts a previous match. (abuts #f)) ; True if start abuts a previous match.

25
test-suite/tests/regexp.test
View file

@ -1,7 +1,7 @@
;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*- ;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
;;;; ;;;;
;;;; Copyright (C) 1999, 2004, 2006, 2007 Free Software Foundation, Inc. ;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
@ -102,6 +102,29 @@
(let ((re (make-regexp "ab+"))) (let ((re (make-regexp "ab+")))
(regexp-exec re "aaaabbbb" 0 'bogus-flags-arg)))) (regexp-exec re "aaaabbbb" 0 'bogus-flags-arg))))
;;;
;;; fold-matches
;;;
(with-test-prefix "fold-matches"
(pass-if "without flags"
(equal? '("hello")
(fold-matches "^[a-z]+$" "hello" '()
(lambda (match result)
(cons (match:substring match)
result)))))
(pass-if "with flags"
;; Prior to 1.8.6, passing an additional flag would not work.
(null?
(fold-matches "^[a-z]+$" "hello" '()
(lambda (match result)
(cons (match:substring match)
result))
(logior regexp/notbol regexp/noteol)))))
;;; ;;;
;;; regexp-quote ;;; regexp-quote
;;; ;;;