Unit test that reveals the problem with REGEXP-SEARCH? after merging 0.6 branch.

This commit is contained in:
jaortega 2008-01-26 20:17:21 +00:00
parent ed5febd39e
commit b0d75bda86
1 changed files with 41 additions and 26 deletions

View File

@ -28,7 +28,7 @@
#f))))))
;; *** help-strings ***
;; *** help-strings ***
(define all-signs-string
(let loop ((i 0))
@ -37,7 +37,7 @@
(string-append (list->string (list (ascii->char i)))
(loop (+ i 1))))))
(define test-string
(define test-string
"Dieser Test-String wurde am 29.07.2004 um 5:23PM erstellt.\na aa aaa aaaa\nab aabb aaabbb\naba abba abbba\n1 12 123 1234\nyyyyyyyyyy\n")
@ -68,7 +68,7 @@
(string-match (rx (| (/ "AZ09") ("aeiou"))) "xxx 6 yyy"))))
(add-test! 'comma-seperated-list-of-REs 'pattern-matching
(lambda ()
(lambda ()
(let ((csl (lambda (re)
(rx (| ""
(: ,re
@ -113,7 +113,7 @@
(submatch "baz")))
(match1 (string-match re "foofoobarsub-f1sub-f2baz"))
(match2 (string-match re-@ "foofoobarsub-f1sub-f2baz")))
(and match1
(and match1
match2
(equal? "baz"
(match:substring match1 3))
@ -167,7 +167,7 @@
(string-match (rx ("edcba")) test-string))))
;; fails only because of the case i = 0
; (add-test! 'any-test 'pattern-matching
; (add-test! 'any-test 'pattern-matching
; (lambda ()
; (let loop ((i 0))
; (if (= 256 i)
@ -233,7 +233,7 @@
(match:substring (string-match (rx (** 1 5 "y")) test-string)))
(not (string-match (rx (** 11 12 "y")) test-string))
(not (string-match (rx (** 12 11 any)) test-string))
(equal? ""
(equal? ""
(match:substring (string-match (rx (** 0 0 any)) test-string))))))
(add-test! 'single-characters-test 'pattern-matching
@ -298,11 +298,11 @@
(not (string-match (rx (w/nocase (~ "a"))) "aA"))
(string-match (rx (w/nocase "abc"
(* "FOO" (w/case "Bar"))
("aeiou")))
("aeiou")))
"kabcfooBariou")
(not (string-match (rx (w/nocase "abc"
(* "FOO" (w/case "Bar"))
("aeiou")))
("aeiou")))
"kabcfooBARiou")))))
(add-test! 'dynamic-re-test-1 'pattern-matching
@ -312,14 +312,14 @@
(you 2))
(and (equal? "feeding the goose"
(match:substring (string-match (rx (: "feeding the "
,(if (> me 1)
"geese"
,(if (> me 1)
"geese"
"goose")))
str)))
(equal? "feeding the geese"
(match:substring (string-match (rx (: "feeding the "
,(if (> you 1)
"geese"
,(if (> you 1)
"geese"
"goose")))
str)))))))
@ -333,11 +333,11 @@
"30"
"31")))))
(and (equal? "on Mar 14"
(match:substring (string-match (rx (: "on " ,date))
(match:substring (string-match (rx (: "on " ,date))
"it was on Mar 14 ...")))
(equal? "on May 31"
(match:substring (string-match (rx (: "on " ,date))
(match:substring (string-match (rx (: "on " ,date))
"it was on May 31 ...")))))))
(add-test! 'regexp?-test 'pattern-matching
@ -358,6 +358,21 @@
(not (regexp-search? (rx "abc") "abcdefg" 3))
(not (regexp-search? (rx "cba") "abcdefg")))))
(letrec ((count 1)
(add-rx-test
(lambda (regexp str/lst result)
(let ((str (if (string? str/lst) str/lst (list->string str/lst)))
(name (format #f "regexp-search?-test-~d" count)))
(set! count (+ 1 count))
(add-test! (string->symbol name) 'pattern-matching
(lambda () (equal? (regexp-search? regexp str) result))))))
(blank-rx (rx bos (* white) #\newline eos)))
(add-rx-test blank-rx "abcd\na" #f)
(add-rx-test blank-rx '(#\newline) #t)
(add-rx-test blank-rx '(#\newline #\newline) #t)
(add-rx-test blank-rx '(#\space #\space #\newline) #t)
(add-rx-test blank-rx "\t \t \n\n" #t))
(add-test! 'regexp-substitute/global-test-1 'pattern-matching
(lambda ()
(equal? "dry Jin"
@ -384,7 +399,7 @@
(lambda (m)
(let ((mon (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
(- (string->number (match:substring m 1))
(- (string->number (match:substring m 1))
1)))
(day (match:substring m 2))
(year (match:substring m 3)))
@ -396,7 +411,7 @@
(let ((kill-matches (lambda (re s)
(regexp-substitute/global #f re s 'pre 'post))))
(equal? " will disappear, also and "
(kill-matches (rx (| "Windows" "tcl" "Intel"))
(kill-matches (rx (| "Windows" "tcl" "Intel"))
"Windows will disappear, also tcl and Intel")))))
(add-test! 'regexp-fold-right-test 'pattern-matching
@ -468,7 +483,7 @@
m
d) =>
(lambda (month)
(equal? month "4")))
(equal? month "4")))
(else #f))
(match-cond ((regexp-search (rx (submatch (+ digit)) "/"
(submatch (+ digit)) "/"
@ -484,7 +499,7 @@
m
d) =>
(lambda (month)
(equal? month "4")))
(equal? month "4")))
(else #t))))))
(add-test! 'flush-submatches-test 'pattern-matching
@ -515,16 +530,16 @@
;; XXX perhaps only a mistake in the manual - it says:
;; XXX perhaps only a mistake in the manual - it says:
;; uncase-char-set was of the type: cset -> re
;; in fact it is of the type: cset -> cset
(add-test! 'uncase-char-set-test 'pattern-matching
(add-test! 'uncase-char-set-test 'pattern-matching
(lambda ()
(equal? "B"
(match:substring (string-match (uncase-char-set (list->char-set (list #\a #\b #\c)))
"dDBb")))))
(add-test! 'uncase-re-char-set-test 'pattern-matching
(add-test! 'uncase-re-char-set-test 'pattern-matching
(lambda ()
(equal? "d"
(match:substring (string-match (uncase (rx (/ "AZ")))
@ -547,7 +562,7 @@
;; (arguments are: (:value :value :value))
;;
;;
(add-test! 'regexp->sre-test 'pattern-matching
(add-test! 'regexp->sre-test 'pattern-matching
(lambda ()
(let ((re (re-seq (list (re-string "Pete ")
(re-repeat 1 #f (re-string "Sz"))
@ -570,7 +585,7 @@
(matches-same-signs? (rx (~ (& alphanumeric numeric)
graphic
(| upper-case numeric)))
(rx (- any
(rx (- any
alphanumeric
graphic)))
(matches-same-signs? (rx (/ "09"))
@ -599,7 +614,7 @@
(? alphanumeric)
(? alphanumeric)
(? alphanumeric))
"xxx")
"xxx")
"xxxabcdexxx")
(string-match (rx (: "xxx" (* (/ "ae")) (+ "x"))) "xxxabcdexxx"))
(eq-match? (string-match (rx "xxxabcdexxx") "xxxabcdexxx")
@ -661,7 +676,7 @@
(and (re-char-set? (make-re-char-set (list->char-set (list #\a #\b #\c))))
(re-char-set? (re-char-set (list->char-set (list #\a #\b #\c))))
(equal? '(#\a #\b #\c)
(char-set->list (re-char-set:cset
(char-set->list (re-char-set:cset
(make-re-char-set (list->char-set (list #\a #\b #\c)))))))))
(add-test! 'regexp-adt-re-dsm-test 'pattern-matching