more tests
This commit is contained in:
chetz
parent
8218b146f8
commit
1e6d6d0841
|
|
@ -13,35 +13,147 @@
|
|||
|
||||
(define eq-match?
|
||||
(lambda (m1 m2)
|
||||
(if (equal? m1 #f)
|
||||
(not m2)
|
||||
(and (= (match:start m1)
|
||||
(match:start m2))
|
||||
(= (match:end m1)
|
||||
(match:end m2))
|
||||
(equal? (match:substring m1)
|
||||
(match:substring m2)))))
|
||||
(match:substring m2))))))
|
||||
|
||||
;; *** tests ***
|
||||
(define matches-same-signs?
|
||||
(lambda (re1 re2)
|
||||
(let loop ((i 0))
|
||||
(if (= 256 i)
|
||||
#t
|
||||
(let ((str (list->string (list (ascii->char i)))))
|
||||
(if (eq-match? (string-match re1 str)
|
||||
(string-match re2 str))
|
||||
(loop (+ i 1))
|
||||
#f))))))
|
||||
|
||||
|
||||
;; *** help-strings ***
|
||||
|
||||
(define all-signs-string
|
||||
(let loop ((i 0))
|
||||
(if (= i 256)
|
||||
""
|
||||
(string-append (list->string (list (ascii->char i)))
|
||||
(loop (+ i 1))))))
|
||||
|
||||
(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")
|
||||
(define nul-string (list->string (list (ascii->char 0) (ascii->char 0))))
|
||||
(define newln-string "\n\n")
|
||||
|
||||
|
||||
;; *** tests ***
|
||||
|
||||
(add-test! 'no-match-test 'pattern-matching
|
||||
(lambda ()
|
||||
(not (string-match (rx "xxx") test-string))))
|
||||
|
||||
(add-test! 'simple-string-match 'pattern-matching
|
||||
(add-test! 'various-forms-of-non-vowels 'pattern-matching
|
||||
(lambda ()
|
||||
(eq-match? (string-match (rx (- alpha ("aeiouAEIOU"))) test-string)
|
||||
(string-match (rx (- (/"azAZ") ("aeiouAEIOU"))) test-string))))
|
||||
(and (eq-match? (string-match (rx (- alpha ("aeiouAEIOU"))) test-string)
|
||||
(string-match (rx (- (/"azAZ") ("aeiouAEIOU"))) test-string))
|
||||
(eq-match? (string-match (rx (- (/"azAZ") ("aeiouAEIOU"))) test-string)
|
||||
(string-match (rx (- alpha ("aeiou") ("AEIOU"))) test-string))
|
||||
(eq-match? (string-match (rx (- alpha ("aeiou") ("AEIOU"))) test-string)
|
||||
(string-match (rx (w/nocase (- alpha ("aeiou")))) test-string))
|
||||
(eq-match? (string-match (rx (w/nocase (- alpha ("aeiou")))) test-string)
|
||||
(string-match (rx (w/nocase (- (/ "az") ("aeiou")))) test-string)))))
|
||||
|
||||
(add-test! 'simple-string-regexp 'pattern-matching
|
||||
(add-test! '|-test 'pattern-matching
|
||||
(lambda ()
|
||||
(eq-match? (string-match (rx (| upper ("aeiou") digit)) "xxx A yyy")
|
||||
(string-match (rx (| (/ "AZ09") ("aeiou"))) "xxx A yyy"))
|
||||
(eq-match? (string-match (rx (| upper ("aeiou") digit)) "xxx a yyy")
|
||||
(string-match (rx (| (/ "AZ09") ("aeiou"))) "xxx a yyy"))
|
||||
(eq-match? (string-match (rx (| upper ("aeiou") digit)) "xxx 6 yyy")
|
||||
(string-match (rx (| (/ "AZ09") ("aeiou"))) "xxx 6 yyy"))))
|
||||
|
||||
(add-test! 'comma-seperated-list-of-REs 'pattern-matching
|
||||
(lambda ()
|
||||
(let ((csl (lambda (re)
|
||||
(rx (| ""
|
||||
(: ,re
|
||||
(* ", " ,re)))))))
|
||||
(string-match (csl (rx (| "John" "Paul" "George" "Ringo")))
|
||||
"George, Ringo, Paul, John"))))
|
||||
|
||||
(add-test! 'repetition-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (equal? "caaadadr"
|
||||
(match:substring (string-match (rx (: "c" (+ (| "a" "d")) "r"))
|
||||
"(caaadadr ...")))
|
||||
(equal? "caaadadr"
|
||||
(match:substring (string-match (rx (: "c" (+ ("ad")) "r"))
|
||||
"(caaadadr ...")))
|
||||
(equal? "caaadadr"
|
||||
(match:substring (string-match (rx (: "c" (** 1 6 ("ad")) "r"))
|
||||
"(caaadadr ...")))
|
||||
(not (string-match (rx (: "c" (** 1 4 ("ad")) "r"))
|
||||
"(caaadadr ...")))))
|
||||
|
||||
(add-test! 'special-cases-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (matches-same-signs? (rx any) (rx (~)))
|
||||
(not (string-match (rx (|)) all-signs-string)))))
|
||||
|
||||
|
||||
|
||||
;XXX something is wrong with this
|
||||
;(add-test! 're-vs-@re-submatch-test 'pattern-matching
|
||||
; (lambda ()
|
||||
; (let* ((f (lambda ()
|
||||
; (rx (submatch "sub-f1")
|
||||
; (submatch "sub-f2"))))
|
||||
; (re (rx (submatch (* "foo"))
|
||||
; (submatch (? "bar"))
|
||||
; ,(f)
|
||||
; (submatch "baz")))
|
||||
; (match1 (string-match ,re "foofoobarsub-f1sub-f2baz"))
|
||||
; (match2 (string-match ,@re "foofoobarsub-f1sub-f2baz")))
|
||||
; (and (...)))))
|
||||
|
||||
(add-test! 'posix-string-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (string-match (rx (posix-string "[aeiou]+|x*|y{3,5}"))
|
||||
"a")
|
||||
(string-match (rx (posix-string "[aeiou]+|x*|y{3,5}"))
|
||||
"x")
|
||||
(string-match (rx (posix-string "[aeiou]+|x*|y{3,5}"))
|
||||
"")
|
||||
(string-match (rx (posix-string "[aeiou]+|x*|y{3,5}"))
|
||||
"yyyy"))))
|
||||
|
||||
(add-test! 'dsm-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (equal? "hello"
|
||||
(match:substring (string-match (rx (dsm 1 0 (submatch "hello")))
|
||||
"bla hello bla")
|
||||
2))
|
||||
(not (match:substring (string-match (rx (dsm 1 0 (submatch "hello")))
|
||||
"bla hello bla")
|
||||
1))
|
||||
(equal? "hello"
|
||||
(match:substring (string-match (rx (dsm 2 0 (submatch "hello")))
|
||||
"bla hello bla")
|
||||
3))
|
||||
(not (match:substring (string-match (rx (dsm 2 0 (submatch "hello")))
|
||||
"bla hello bla")
|
||||
1))
|
||||
(not (match:substring (string-match (rx (dsm 2 0 (submatch "hello")))
|
||||
"bla hello bla")
|
||||
2)))))
|
||||
|
||||
(add-test! 'string-regexp 'pattern-matching
|
||||
(lambda ()
|
||||
(and (equal? "erstellt."
|
||||
(match:substring (string-match (rx "erstellt.") test-string)))
|
||||
(not (string-match (rx "Erstellt.") test-string)))))
|
||||
|
||||
(add-test! 'simple-character-set 'pattern-matching
|
||||
(add-test! 'character-set 'pattern-matching
|
||||
(lambda ()
|
||||
(eq-match? (string-match (rx ("abcde")) test-string)
|
||||
(string-match (rx ("edcba")) test-string))))
|
||||
|
|
@ -191,11 +303,15 @@
|
|||
(you 2))
|
||||
(and (equal? "feeding the goose"
|
||||
(match:substring (string-match (rx (: "feeding the "
|
||||
,(if (> me 1) "geese" "goose")))
|
||||
,(if (> me 1)
|
||||
"geese"
|
||||
"goose")))
|
||||
str)))
|
||||
(equal? "feeding the geese"
|
||||
(match:substring (string-match (rx (: "feeding the "
|
||||
,(if (> you 1) "geese" "goose")))
|
||||
,(if (> you 1)
|
||||
"geese"
|
||||
"goose")))
|
||||
str)))))))
|
||||
|
||||
(add-test! 'dynamic-re-test-2 'pattern-matching
|
||||
|
|
@ -208,10 +324,12 @@
|
|||
"30"
|
||||
"31")))))
|
||||
(and (equal? "on Mar 14"
|
||||
(match:substring (string-match (rx (: "on " ,date)) "it was 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 ...")))))))
|
||||
(match:substring (string-match (rx (: "on " ,date))
|
||||
"it was on May 31 ...")))))))
|
||||
|
||||
(add-test! 'regexp?-test 'pattern-matching
|
||||
(lambda ()
|
||||
|
|
@ -257,7 +375,8 @@
|
|||
(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)))
|
||||
(- (string->number (match:substring m 1))
|
||||
1)))
|
||||
(day (match:substring m 2))
|
||||
(year (match:substring m 3)))
|
||||
(string-append mon " " day ", 19" year)))
|
||||
|
|
@ -268,7 +387,8 @@
|
|||
(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")))))
|
||||
(kill-matches (rx (| "Windows" "tcl" "Intel"))
|
||||
"Windows will disappear, also tcl and Intel")))))
|
||||
|
||||
(add-test! 'regexp-fold-right-test 'pattern-matching
|
||||
(lambda ()
|
||||
|
|
@ -288,12 +408,118 @@
|
|||
(whole-date month day year)
|
||||
(string-append whole-date "\nmonth: " month "\nday: " day "\nyear: " year)))))
|
||||
|
||||
(add-test! 'if-match-test 'pattern-matching
|
||||
(lambda ()
|
||||
(and (if-match (regexp-search (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"here comes a date: 3/1/79")
|
||||
(whole-date month day year)
|
||||
(and (equal? month "3")
|
||||
(equal? day "1")
|
||||
(equal? year "79"))
|
||||
#f)
|
||||
(if-match (regexp-search (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"here comes a date: 3|1|79")
|
||||
(whole-date month day year)
|
||||
(and (equal? month "3")
|
||||
(equal? day "1")
|
||||
(equal? year "79"))
|
||||
#t))))
|
||||
|
||||
(add-test! 'match-cond-test 'pattern-matching
|
||||
(lambda ()
|
||||
(let ((m "")
|
||||
(d "")
|
||||
(y ""))
|
||||
(and (match-cond ((regexp-search (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"here comes a date: 3/1/79")
|
||||
(whole-date month day year)
|
||||
(begin (set! m month)
|
||||
(set! d day)
|
||||
(set! y year)))
|
||||
(test (equal? m "3")
|
||||
#t)
|
||||
(else #f))
|
||||
(match-cond ((regexp-search (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"here comes a date: 4/1/79")
|
||||
(whole-date month day year)
|
||||
(begin (set! m month)
|
||||
(set! d day)
|
||||
(set! y year)))
|
||||
(test (equal? m "3")
|
||||
#t)
|
||||
(test (if (equal? m "4")
|
||||
m
|
||||
d) =>
|
||||
(lambda (month)
|
||||
(equal? month "4")))
|
||||
(else #f))
|
||||
(match-cond ((regexp-search (rx (submatch (+ digit)) "/"
|
||||
(submatch (+ digit)) "/"
|
||||
(submatch (+ digit)))
|
||||
"here comes a date: 5/1/79")
|
||||
(whole-date month day year)
|
||||
(begin (set! m month)
|
||||
(set! d day)
|
||||
(set! y year)))
|
||||
(test (equal? m "3")
|
||||
#t)
|
||||
(test (if (equal? m "4")
|
||||
m
|
||||
d) =>
|
||||
(lambda (month)
|
||||
(equal? month "4")))
|
||||
(else #t))))))
|
||||
|
||||
(add-test! 'flush-submatches-test 'pattern-matching
|
||||
(lambda ()
|
||||
(let ((re (rx (submatch "foo")
|
||||
(submatch "bar"))))
|
||||
(and (= 2
|
||||
(re-seq:tsm re))
|
||||
(= 0
|
||||
(re-seq:tsm (flush-submatches re)))
|
||||
(equal? "foobar"
|
||||
(match:substring (string-match (flush-submatches re)
|
||||
"foobar")))))))
|
||||
|
||||
(add-test! 'uncase-test 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? "FoO"
|
||||
(match:substring (string-match (uncase (rx "foo"))
|
||||
"FoO")))))
|
||||
|
||||
;; XXX no idea how to test simplify-regexp
|
||||
|
||||
|
||||
|
||||
;; 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 'patern-matching
|
||||
(lambda ()
|
||||
(equal? "B"
|
||||
(match:substring (string-match (uncase-char-set (list->char-set (list #\a #\b #\c)))
|
||||
"dDBb")))))
|
||||
|
||||
(add-test! 'uncase-string-test 'pattern-matching
|
||||
(lambda ()
|
||||
(equal? "FoO"
|
||||
(match:substring (string-match (uncase-string "foo")
|
||||
"FoO")))))
|
||||
(add-test! 'sre->regexp-test 'pattern-matching
|
||||
(lambda ()
|
||||
(regexp? (sre->regexp '(: "Christoph " (? "F. ") "Hetz")))))
|
||||
|
||||
|
||||
|
||||
;; XXX
|
||||
;;Warning: wrong number of arguments
|
||||
;; (re-seq (re-string "Pete ") (re-repeat 1 #f (re-string "Sz")) (re-string "ilagyi"))
|
||||
;; (procedure wants: (:value))
|
||||
|
|
@ -307,7 +533,3 @@
|
|||
; (re-repeat 1 #f (re-string "Sz"))
|
||||
; (re-string "ilagyi")))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -328,13 +328,43 @@
|
|||
|
||||
;; ===============================================================================================
|
||||
|
||||
(add-test! 'read-delimited!-with-char-set-test 'read-delimited-strings
|
||||
|
||||
;; XXX read-delimited! and %read-delimited! are confusing bugy
|
||||
;(add-test! 'read-delimited!-with-char-set-test 'read-delimited-strings
|
||||
; (lambda ()
|
||||
; (let ((buf " "))
|
||||
; ((lambda (in-port)
|
||||
; (read-delimited! (list->char-set (list #\a #\b #\1))
|
||||
; buf
|
||||
; in-port)
|
||||
; (equal? "zeile a "
|
||||
; buf))
|
||||
; (make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))))
|
||||
|
||||
|
||||
;; ====================================================================================================
|
||||
|
||||
(add-test! 'skip-char-set-wiht-charset-test 'read-delimited-strings
|
||||
(lambda ()
|
||||
(let ((buf " "))
|
||||
((lambda (in-port)
|
||||
(read-delimited! (list->char-set (list #\a #\b #\1))
|
||||
buf
|
||||
in-port)
|
||||
(equal? "zeile a "
|
||||
buf))
|
||||
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))))
|
||||
(= 6
|
||||
(skip-char-set (list->char-set (list #\a #\b #\c))
|
||||
(make-string-input-port "abccbaxxx")))))
|
||||
|
||||
|
||||
(add-test! 'skip-char-set-wiht-string-test 'read-delimited-strings
|
||||
(lambda ()
|
||||
(= 6
|
||||
(skip-char-set "abc"
|
||||
(make-string-input-port "abccbaxxx")))))
|
||||
|
||||
(add-test! 'skip-char-set-wiht-character-test 'read-delimited-strings
|
||||
(lambda ()
|
||||
(= 6
|
||||
(skip-char-set #\a
|
||||
(make-string-input-port "aaaaaaxxx")))))
|
||||
|
||||
(add-test! 'skip-char-set-wiht-character-predicate-test 'read-delimited-strings
|
||||
(lambda ()
|
||||
(= 6
|
||||
(skip-char-set char-digit?
|
||||
(make-string-input-port "123456xxx")))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue