more test cases
This commit is contained in:
chetz
parent
3c4a6c7c46
commit
2bc4c06457
|
|
@ -121,7 +121,192 @@
|
|||
(eq-match? (string-match (rx ("xy")) test-string)
|
||||
(string-match (rx (| #\x #\y)) test-string)))))
|
||||
|
||||
;(add-test! 'range-test 'pattern-matching
|
||||
(add-test! 'range-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (equal? "D"
|
||||
(match:substring (string-match (rx (/ #\A #\Z #\a #\z #\0 #\9)) test-string)))
|
||||
(equal? "D"
|
||||
(match:substring (string-match (rx (/ #\A "Zaz0" #\9)) test-string)))
|
||||
(equal? "i"
|
||||
(match:substring (string-match (rx (/ #\a #\z #\0 #\9)) test-string)))
|
||||
(equal? "i"
|
||||
(match:substring (string-match (rx (/ #\a "z0" #\9)) test-string)))
|
||||
(equal? "2"
|
||||
(match:substring (string-match (rx (/ #\0 #\9)) test-string)))
|
||||
(equal? "2"
|
||||
(match:substring (string-match (rx (/ "0" #\9)) test-string))))))
|
||||
|
||||
(add-test! 'character-classes-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (eq-match? (string-match (rx lower-case) test-string)
|
||||
(string-match (rx (- alphabetic upper-case)) test-string))
|
||||
(eq-match? (string-match (rx upper-case) test-string)
|
||||
(string-match (rx (- alphabetic lower-case)) test-string))
|
||||
(equal? "2"
|
||||
(match:substring (string-match (rx numeric) test-string)))
|
||||
(equal? "-"
|
||||
(match:substring (string-match (rx punctuation) test-string)))
|
||||
(equal? " "
|
||||
(match:substring (string-match (rx blank) test-string)))
|
||||
(equal? " "
|
||||
(match:substring (string-match (rx whitespace) test-string)))
|
||||
(equal? "\n"
|
||||
(match:substring (string-match (rx control) test-string)))
|
||||
(equal? "D"
|
||||
(match:substring (string-match (rx hex-digit) test-string)))
|
||||
(equal? "D"
|
||||
(match:substring (string-match (rx ascii) test-string))))))
|
||||
|
||||
(add-test! 'uncsae-w/case-w/nocase-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (equal? "foo"
|
||||
(match:substring (string-match (rx (uncase "foo")) "bla foo bla")))
|
||||
(equal? "FOO"
|
||||
(match:substring (string-match (rx (uncase "foo")) "bla FOO bla")))
|
||||
(equal? "FOo"
|
||||
(match:substring (string-match (rx (uncase "foo")) "bla FOo bla")))
|
||||
(equal? "fOo"
|
||||
(match:substring (string-match (rx (uncase "foo")) "bla fOo bla")))
|
||||
(equal? "FoO"
|
||||
(match:substring (string-match (rx (uncase "foo")) "bla FoO bla")))
|
||||
(equal? "a"
|
||||
(match:substring (string-match (rx (uncase (~ "a"))) "a")))
|
||||
(equal? "A"
|
||||
(match:substring (string-match (rx (uncase (~ "a"))) "A")))
|
||||
(not (string-match (rx (w/nocase (~ "a"))) "aA"))
|
||||
(string-match (rx (w/nocase "abc"
|
||||
(* "FOO" (w/case "Bar"))
|
||||
("aeiou")))
|
||||
"kabcfooBariou")
|
||||
(not (string-match (rx (w/nocase "abc"
|
||||
(* "FOO" (w/case "Bar"))
|
||||
("aeiou")))
|
||||
"kabcfooBARiou")))))
|
||||
|
||||
(add-test! 'dynamic-re-test-1 'pattern-matching
|
||||
(lambda ()
|
||||
(let ((str "I am feeding the goose, you are feeding the geese.")
|
||||
(me 1)
|
||||
(you 2))
|
||||
(and (equal? "feeding the goose"
|
||||
(match:substring (string-match (rx (: "feeding the "
|
||||
,(if (> me 1) "geese" "goose")))
|
||||
str)))
|
||||
(equal? "feeding the geese"
|
||||
(match:substring (string-match (rx (: "feeding the "
|
||||
,(if (> you 1) "geese" "goose")))
|
||||
str)))))))
|
||||
|
||||
(add-test! 'dynamic-re-test-2 'pattern-matching
|
||||
(lambda ()
|
||||
(let* ((ws (rx (+ whitespace)))
|
||||
(date (rx (: (| "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul")
|
||||
,ws
|
||||
(| ("123456789")
|
||||
(: ("12") digit)
|
||||
"30"
|
||||
"31")))))
|
||||
(and (equal? "on Mar 14"
|
||||
(match:substring (string-match (rx (: "on " ,date)) "it was on Mar 14 ...")))
|
||||
|
||||
(equal? "on May 31"
|
||||
(match:substring (string-match (rx (: "on " ,date)) "it was on May 31 ...")))))))
|
||||
|
||||
(add-test! 'regexp?-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (not (regexp? "abc"))
|
||||
(regexp? (rx "abc")))))
|
||||
|
||||
(add-test! 'regexp-search-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (equal? "abc"
|
||||
(match:substring (regexp-search (rx "abc") "abcdefg")))
|
||||
(not (regexp-search (rx "abc") "abcdefg" 3))
|
||||
(not (regexp-search (rx "cba") "abcdefg")))))
|
||||
|
||||
(add-test! 'regexp-search?-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (regexp-search? (rx "abc") "abcdefg")
|
||||
(not (regexp-search? (rx "abc") "abcdefg" 3))
|
||||
(not (regexp-search? (rx "cba") "abcdefg")))))
|
||||
|
||||
(add-test! 'regexp-substitute/global-test-1 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? "dry Jin"
|
||||
(regexp-substitute/global #f (rx "Cotton") "dry Cotton"
|
||||
'pre "Jin" 'post))))
|
||||
|
||||
(add-test! 'regexp-substitute/global-test-2 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? "01/03/79"
|
||||
(regexp-substitute/global #f (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"03/01/79"
|
||||
'pre 2 "/" 1 "/" 3 'post))))
|
||||
|
||||
(add-test! 'regexp-substitute/global-test-3 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? "Sep 29, 1961"
|
||||
(regexp-substitute/global #f (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"9/29/61"
|
||||
'pre
|
||||
(lambda (m)
|
||||
(let ((mon (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun"
|
||||
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
|
||||
(- (string->number (match:substring m 1)) 1)))
|
||||
(day (match:substring m 2))
|
||||
(year (match:substring m 3)))
|
||||
(string-append mon " " day ", 19" year)))
|
||||
'post))))
|
||||
|
||||
(add-test! 'regexp-substitute/global-test-4 'pattern-matching
|
||||
(lambda ()
|
||||
(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")) "Windows will disappear, also tcl and Intel")))))
|
||||
|
||||
(add-test! 'regexp-fold-right-test 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? (list "1" "1" "2" "2")
|
||||
(regexp-fold-right (rx digit)
|
||||
(lambda (m i lis)
|
||||
(cons (match:substring m 0) lis))
|
||||
'() "a1 b1 a2 b2 ..."))))
|
||||
|
||||
(add-test! 'let-match-test 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? "3/1/79\nmonth: 3\nday: 1\nyear: 79"
|
||||
(let-match (regexp-search (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"here comes a date: 3/1/79")
|
||||
(whole-date month day year)
|
||||
(string-append whole-date "\nmonth: " month "\nday: " day "\nyear: " year)))))
|
||||
|
||||
(add-test! 'sre->regexp-test 'pattern-matching
|
||||
(lambda ()
|
||||
(regexp? (sre->regexp '(: "Christoph " (? "F. ") "Hetz")))))
|
||||
|
||||
|
||||
|
||||
;;Warning: wrong number of arguments
|
||||
;; (re-seq (re-string "Pete ") (re-repeat 1 #f (re-string "Sz")) (re-string "ilagyi"))
|
||||
;; (procedure wants: (:value))
|
||||
;; (arguments are: (:value :value :value))
|
||||
;;
|
||||
;;
|
||||
;(add-test! 'regexp->sre-test 'pattern-matching
|
||||
; (lambda ()
|
||||
; (and (equal? "D"
|
||||
; (match-substring
|
||||
; (equal? '(? "Pete" (+ "Sz") "ilagyi")
|
||||
; (regexp->sre (re-repeat 0 1 (re-seq (re-string "Pete ")
|
||||
; (re-repeat 1 #f (re-string "Sz"))
|
||||
; (re-string "ilagyi")))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue