restore support for sub-matches in `regexp-replace*'

This commit is contained in:
Matthew Flatt 2010-06-26 18:22:08 -06:00
parent 4fe07902d9
commit dc99e1992c
3 changed files with 24 additions and 8 deletions

View File

@ -326,8 +326,8 @@
(if (and (not needs-string?) (string? orig-replacement))
(string->bytes/utf-8 orig-replacement)
orig-replacement))
(define (check proc arg)
(let ([v (proc arg)])
(define (check proc args)
(let ([v (apply proc args)])
(unless (if needs-string?
(string? v)
(bytes? v))
@ -388,9 +388,8 @@
(raise-type-error 'regexp-replace* "string or byte string" string))
(unless (or (string? replacement)
(bytes? replacement)
(and (procedure? replacement)
(procedure-arity-includes? replacement 1)))
(raise-type-error 'regexp-replace* "string, byte string, or procedure (arity 1)"
(procedure? replacement))
(raise-type-error 'regexp-replace* "string, byte string, or procedure"
replacement))
(when (and needs-string? (bytes? replacement))
(raise-mismatch-error 'regexp-replace*
@ -404,7 +403,8 @@
(lambda (start mstart mend ms acc) (list* (if (procedure? replacement)
(check
replacement
(sub buf mstart mend))
(for/list ([m ms])
(sub buf (car m) (cdr m))))
(replac ms replacement))
(sub buf start mstart)
acc))

View File

@ -741,8 +741,8 @@ before the @litchar{\}. For example, the Racket constant
@defproc[(regexp-replace* [pattern (or/c string? bytes? regexp? byte-regexp?)]
[input (or/c string? bytes?)]
[insert (or/c string? bytes?
(string? . -> . string?)
(bytes? . -> . bytes?))]
((string?) () #:rest (listof string?) . ->* . string?)
((bytes?) () #:rest (listof bytes?) . ->* . bytes?))]
[input-prefix bytes? #""])
(or/c string? bytes?)]{

View File

@ -1074,6 +1074,22 @@
(test "x&cy&z" regexp-replace* #rx"a(.)" "xabcyawz" "\\&")
(test "x\\cy\\z" regexp-replace* #rx"a(.)" "xabcyawz" "\\\\")
;; Test sub-matches with procedure replace (second example by synx)
(test "myCERVEZA myMI Mi"
regexp-replace* "([Mm])i ([a-zA-Z]*)" "mi cerveza Mi Mi Mi"
(lambda (all one two)
(string-append (string-downcase one) "y"
(string-upcase two))))
(test #"fox in socks, blue seal. trout in socks, blue fish!"
regexp-replace*
#rx#"([a-z]+) ([a-z]+)"
#"red fox, blue seal. red trout, blue trout!"
(lambda (total color what)
(cond
((equal? color #"red") (bytes-append what #" in socks"))
((equal? what #"trout") (bytes-append color #" fish"))
(else (bytes-append color #" " what)))))
;; Test weird port offsets:
(define (test-weird-offset regexp-match regexp-match-positions)
(test #f regexp-match "e" (open-input-string ""))