Unit test that reveals the problem with REGEXP-SEARCH? after merging 0.6 branch.
This commit is contained in:
parent
ed5febd39e
commit
b0d75bda86
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue