suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix address parsing to handle comma in parenthesized form

Browse Source 
svn: r3163
This commit is contained in:
Matthew Flatt 2006-06-01 00:08:10 +00:00
parent c666a5cae2
commit 17a22c798b
2 changed files with 53 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/net/head-unit.ss
View File

@ -165,6 +165,7 @@
(define nonblank "[^ \t\n\r\v]")
(define re:all-blank (regexp (format "^~a*$" blank)))
(define re:quoted (regexp "\"[^\"]*\""))
(define re:parened (regexp "[(][^)]*[)]"))
(define re:comma (regexp ","))
(define re:comma-separated (regexp "([^,]*),(.*)"))
@ -177,8 +178,14 @@
null
(let loop ([prefix ""][s s])
;; Which comes first - a quote or a comma?
(let ([mq (regexp-match-positions re:quoted s)]
[mc (regexp-match-positions re:comma s)])
(let* ([mq1 (regexp-match-positions re:quoted s)]
[mq2 (regexp-match-positions re:parened s)]
[mq (if (and mq1 mq2)
(if (< (caar mq1) (caar mq2))
mq1
mq2)
(or mq1 mq2))]
[mc (regexp-match-positions re:comma s)])
(if (and mq mc (< (caar mq) (caar mc) (cdar mq)))
;; Quote contains a comma
(loop (string-append

44
collects/tests/mzscheme/head.ss Normal file
View File

@ -0,0 +1,44 @@
(load-relative "loadtest.ss")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; url.ss tests
;;
(require (lib "head.ss" "net"))
(for-each
(lambda (addr)
(test '("o.gu@plt-scheme.com") extract-addresses (car addr) 'address)
(test '("o.gu@plt-scheme.com" "o.gu@plt-scheme.com") extract-addresses
(format "~a, ~a" (car addr) (car addr))
'address)
(test (list (cdr addr)) extract-addresses (car addr) 'name)
(for-each
(lambda (addr2)
(let ([two (format " ~a, \n\t~a" (car addr) (car addr2))])
(test '("o.gu@plt-scheme.com" "s.gu@plt-scheme.org") extract-addresses two 'address)
(test (list (cdr addr) (cdr addr2)) extract-addresses two 'name)))
'(("s.gu@plt-scheme.org" . "s.gu@plt-scheme.org")
("<s.gu@plt-scheme.org>" . "s.gu@plt-scheme.org")
("s.gu@plt-scheme.org (Gu, Sophia)" . "Gu, Sophia")
("s.gu@plt-scheme.org (Sophia Gu)" . "Sophia Gu")
("s.gu@plt-scheme.org (Sophia \"Sophie\" Gu)" . "Sophia \"Sophie\" Gu")
("Sophia Gu <s.gu@plt-scheme.org>" . "Sophia Gu")
("\"Gu, Sophia\" <s.gu@plt-scheme.org>" . "\"Gu, Sophia\"")
("\"Gu, Sophia (Sophie)\" <s.gu@plt-scheme.org>" . "\"Gu, Sophia (Sophie)\""))))
'(("o.gu@plt-scheme.com" . "o.gu@plt-scheme.com")
("<o.gu@plt-scheme.com>" . "o.gu@plt-scheme.com")
("o.gu@plt-scheme.com (Gu, Oliver)" . "Gu, Oliver")
("o.gu@plt-scheme.com (Oliver Gu)" . "Oliver Gu")
("o.gu@plt-scheme.com (Oliver \"Ollie\" Gu)" . "Oliver \"Ollie\" Gu")
("o.gu@plt-scheme.com (Oliver \"Ollie Gu)" . "Oliver \"Ollie Gu")
("Oliver Gu <o.gu@plt-scheme.com>" . "Oliver Gu")
("\"Gu, Oliver\" <o.gu@plt-scheme.com>" . "\"Gu, Oliver\"")
("\"Gu, Oliver (Ollie)\" <o.gu@plt-scheme.com>" . "\"Gu, Oliver (Ollie)\"")
("\"Gu, Oliver (Ollie\" <o.gu@plt-scheme.com>" . "\"Gu, Oliver (Ollie\"")
("\"Gu, Oliver (Ollie, himself)\" <o.gu@plt-scheme.com>" . "\"Gu, Oliver (Ollie, himself)\"")))
(report-errs)