From 2bc4c06457cf641d09f499f75e58725fce012b23 Mon Sep 17 00:00:00 2001 From: chetz Date: Thu, 12 Aug 2004 15:13:18 +0000 Subject: [PATCH] more test cases --- scsh/test/pattern-matching-test.scm | 191 +++++++++++++++++++++++++++- 1 file changed, 188 insertions(+), 3 deletions(-) diff --git a/scsh/test/pattern-matching-test.scm b/scsh/test/pattern-matching-test.scm index ef88777..4ab826f 100644 --- a/scsh/test/pattern-matching-test.scm +++ b/scsh/test/pattern-matching-test.scm @@ -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 \ No newline at end of file +; (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"))))))) + + + + +