diff --git a/scsh/test/pattern-matching-test.scm b/scsh/test/pattern-matching-test.scm index 934f2ae..51a7966 100644 --- a/scsh/test/pattern-matching-test.scm +++ b/scsh/test/pattern-matching-test.scm @@ -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