scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more tests

This commit is contained in:
chetz 2004-08-18 13:55:35 +00:00
parent 8218b146f8
commit 1e6d6d0841
2 changed files with 737 additions and 485 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

682
scsh/test/pattern-matching-test.scm
View File

@ -13,287 +13,513 @@
(define eq-match? (define eq-match?
(lambda (m1 m2) (lambda (m1 m2)
(and (= (match:start m1) (if (equal? m1 #f)
(match:start m2)) (not m2)
(= (match:end m1) (and (= (match:start m1)
(match:end m2)) (match:start m2))
(equal? (match:substring m1) (= (match:end m1)
(match:substring m2))))) (match:end m2))
(equal? (match:substring m1)
(match:substring m2))))))
(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")
;; *** tests *** ;; *** tests ***
(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")
(add-test! 'no-match-test 'pattern-matching (add-test! 'no-match-test 'pattern-matching
(lambda () (lambda ()
(not (string-match (rx "xxx") test-string)))) (not (string-match (rx "xxx") test-string))))
(add-test! 'simple-string-match 'pattern-matching (add-test! 'various-forms-of-non-vowels 'pattern-matching
(lambda () (lambda ()
(eq-match? (string-match (rx (- alpha ("aeiouAEIOU"))) test-string) (and (eq-match? (string-match (rx (- alpha ("aeiouAEIOU"))) test-string)
(string-match (rx (- (/"azAZ") ("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 () (lambda ()
(and (equal? "erstellt." (eq-match? (string-match (rx (| upper ("aeiou") digit)) "xxx A yyy")
(match:substring (string-match (rx "erstellt.") test-string))) (string-match (rx (| (/ "AZ09") ("aeiou"))) "xxx A yyy"))
(not (string-match (rx "Erstellt.") test-string))))) (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! 'simple-character-set 'pattern-matching (add-test! 'comma-seperated-list-of-REs 'pattern-matching
(lambda () (lambda ()
(eq-match? (string-match (rx ("abcde")) test-string) (let ((csl (lambda (re)
(string-match (rx ("edcba")) test-string)))) (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! 'character-set 'pattern-matching
(lambda ()
(eq-match? (string-match (rx ("abcde")) test-string)
(string-match (rx ("edcba")) test-string))))
(add-test! 'any-test 'pattern-matching ;; fails only because of the case i = 0 (add-test! 'any-test 'pattern-matching ;; fails only because of the case i = 0
(lambda () (lambda ()
(let loop ((i 0)) (let loop ((i 0))
(if (= 256 i) (if (= 256 i)
#t #t
(if (string-match (rx any) (list->string (list (ascii->char i)))) (if (string-match (rx any) (list->string (list (ascii->char i))))
(loop (+ i 1)) (loop (+ i 1))
#f))))) #f)))))
(add-test! 'sequences-test 'pattern-matching (add-test! 'sequences-test 'pattern-matching
(lambda () (lambda ()
(equal? "1234" (equal? "1234"
(match:substring (string-match (rx (: "1" any any "4")) test-string))))) (match:substring (string-match (rx (: "1" any any "4")) test-string)))))
(add-test! 'choices 'pattern-matching (add-test! 'choices 'pattern-matching
(lambda () (lambda ()
(let ((m1 (string-match (rx (| "erstellt." "xxx")) test-string)) (let ((m1 (string-match (rx (| "erstellt." "xxx")) test-string))
(m2 (string-match (rx (| "xxx" "erstellt.")) test-string))) (m2 (string-match (rx (| "xxx" "erstellt.")) test-string)))
(and m1 (and m1
m2 m2
(eq-match? m1 m2))))) (eq-match? m1 m2)))))
(add-test! '*-test 'pattern-matching (add-test! '*-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "" (and (equal? ""
(match:substring (string-match (rx (* "y")) test-string))) (match:substring (string-match (rx (* "y")) test-string)))
(equal? "D" (equal? "D"
(match:substring (string-match (rx (* "D")) test-string)))))) (match:substring (string-match (rx (* "D")) test-string))))))
(add-test! '+-test 'pattern-matching (add-test! '+-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "yyyyyyyyyy" (and (equal? "yyyyyyyyyy"
(match:substring (string-match (rx (+ "y")) test-string))) (match:substring (string-match (rx (+ "y")) test-string)))
(equal? "D" (equal? "D"
(match:substring (string-match (rx (+ "D")) test-string)))))) (match:substring (string-match (rx (+ "D")) test-string))))))
(add-test! '?-test 'pattern-matching (add-test! '?-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "" (and (equal? ""
(match:substring (string-match (rx (? "y")) test-string))) (match:substring (string-match (rx (? "y")) test-string)))
(equal? "D" (equal? "D"
(match:substring (string-match (rx (? "D")) test-string)))))) (match:substring (string-match (rx (? "D")) test-string))))))
(add-test! '=-from-test 'pattern-matching (add-test! '=-from-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "yyyyy" (and (equal? "yyyyy"
(match:substring (string-match (rx (= 5 "y")) test-string))) (match:substring (string-match (rx (= 5 "y")) test-string)))
(not (string-match (rx (= 11 "y")) test-string))))) (not (string-match (rx (= 11 "y")) test-string)))))
(add-test! '>=-from-test 'pattern-matching (add-test! '>=-from-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "yyyyyyyyyy" (and (equal? "yyyyyyyyyy"
(match:substring (string-match (rx (>= 5 "y")) test-string))) (match:substring (string-match (rx (>= 5 "y")) test-string)))
(equal? "yyyyyyyyyy" (equal? "yyyyyyyyyy"
(match:substring (string-match (rx (>= 10 "y")) test-string))) (match:substring (string-match (rx (>= 10 "y")) test-string)))
(not (string-match (rx (>= 11 "y")) test-string))))) (not (string-match (rx (>= 11 "y")) test-string)))))
(add-test! '**from-to-test 'pattern-matching (add-test! '**from-to-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "yyyyyyyyyy" (and (equal? "yyyyyyyyyy"
(match:substring (string-match (rx (** 1 30 "y")) test-string))) (match:substring (string-match (rx (** 1 30 "y")) test-string)))
(equal? "yyyyy" (equal? "yyyyy"
(match:substring (string-match (rx (** 1 5 "y")) test-string))) (match:substring (string-match (rx (** 1 5 "y")) test-string)))
(not (string-match (rx (** 11 12 "y")) test-string)) (not (string-match (rx (** 11 12 "y")) test-string))
(not (string-match (rx (** 12 11 any)) test-string)) (not (string-match (rx (** 12 11 any)) test-string))
(equal? "" (equal? ""
(match:substring (string-match (rx (** 0 0 any)) test-string)))))) (match:substring (string-match (rx (** 0 0 any)) test-string))))))
(add-test! 'single-characters-test 'pattern-matching (add-test! 'single-characters-test 'pattern-matching
(lambda () (lambda ()
(and (eq-match? (string-match (rx ("abcd")) test-string) (and (eq-match? (string-match (rx ("abcd")) test-string)
(string-match (rx (| #\a #\b #\c #\d)) test-string)) (string-match (rx (| #\a #\b #\c #\d)) test-string))
(eq-match? (string-match (rx ("xy")) test-string) (eq-match? (string-match (rx ("xy")) test-string)
(string-match (rx (| #\x #\y)) test-string))))) (string-match (rx (| #\x #\y)) test-string)))))
(add-test! 'range-test 'pattern-matching (add-test! 'range-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "D" (and (equal? "D"
(match:substring (string-match (rx (/ #\A #\Z #\a #\z #\0 #\9)) test-string))) (match:substring (string-match (rx (/ #\A #\Z #\a #\z #\0 #\9)) test-string)))
(equal? "D" (equal? "D"
(match:substring (string-match (rx (/ #\A "Zaz0" #\9)) test-string))) (match:substring (string-match (rx (/ #\A "Zaz0" #\9)) test-string)))
(equal? "i" (equal? "i"
(match:substring (string-match (rx (/ #\a #\z #\0 #\9)) test-string))) (match:substring (string-match (rx (/ #\a #\z #\0 #\9)) test-string)))
(equal? "i" (equal? "i"
(match:substring (string-match (rx (/ #\a "z0" #\9)) test-string))) (match:substring (string-match (rx (/ #\a "z0" #\9)) test-string)))
(equal? "2" (equal? "2"
(match:substring (string-match (rx (/ #\0 #\9)) test-string))) (match:substring (string-match (rx (/ #\0 #\9)) test-string)))
(equal? "2" (equal? "2"
(match:substring (string-match (rx (/ "0" #\9)) test-string)))))) (match:substring (string-match (rx (/ "0" #\9)) test-string))))))
(add-test! 'character-classes-test 'pattern-matching (add-test! 'character-classes-test 'pattern-matching
(lambda () (lambda ()
(and (eq-match? (string-match (rx lower-case) test-string) (and (eq-match? (string-match (rx lower-case) test-string)
(string-match (rx (- alphabetic upper-case)) test-string)) (string-match (rx (- alphabetic upper-case)) test-string))
(eq-match? (string-match (rx upper-case) test-string) (eq-match? (string-match (rx upper-case) test-string)
(string-match (rx (- alphabetic lower-case)) test-string)) (string-match (rx (- alphabetic lower-case)) test-string))
(equal? "2" (equal? "2"
(match:substring (string-match (rx numeric) test-string))) (match:substring (string-match (rx numeric) test-string)))
(equal? "-" (equal? "-"
(match:substring (string-match (rx punctuation) test-string))) (match:substring (string-match (rx punctuation) test-string)))
(equal? " " (equal? " "
(match:substring (string-match (rx blank) test-string))) (match:substring (string-match (rx blank) test-string)))
(equal? " " (equal? " "
(match:substring (string-match (rx whitespace) test-string))) (match:substring (string-match (rx whitespace) test-string)))
(equal? "\n" (equal? "\n"
(match:substring (string-match (rx control) test-string))) (match:substring (string-match (rx control) test-string)))
(equal? "D" (equal? "D"
(match:substring (string-match (rx hex-digit) test-string))) (match:substring (string-match (rx hex-digit) test-string)))
(equal? "D" (equal? "D"
(match:substring (string-match (rx ascii) test-string)))))) (match:substring (string-match (rx ascii) test-string))))))
(add-test! 'uncsae-w/case-w/nocase-test 'pattern-matching (add-test! 'uncsae-w/case-w/nocase-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "foo" (and (equal? "foo"
(match:substring (string-match (rx (uncase "foo")) "bla foo bla"))) (match:substring (string-match (rx (uncase "foo")) "bla foo bla")))
(equal? "FOO" (equal? "FOO"
(match:substring (string-match (rx (uncase "foo")) "bla FOO bla"))) (match:substring (string-match (rx (uncase "foo")) "bla FOO bla")))
(equal? "FOo" (equal? "FOo"
(match:substring (string-match (rx (uncase "foo")) "bla FOo bla"))) (match:substring (string-match (rx (uncase "foo")) "bla FOo bla")))
(equal? "fOo" (equal? "fOo"
(match:substring (string-match (rx (uncase "foo")) "bla fOo bla"))) (match:substring (string-match (rx (uncase "foo")) "bla fOo bla")))
(equal? "FoO" (equal? "FoO"
(match:substring (string-match (rx (uncase "foo")) "bla FoO bla"))) (match:substring (string-match (rx (uncase "foo")) "bla FoO bla")))
(equal? "a" (equal? "a"
(match:substring (string-match (rx (uncase (~ "a"))) "a"))) (match:substring (string-match (rx (uncase (~ "a"))) "a")))
(equal? "A" (equal? "A"
(match:substring (string-match (rx (uncase (~ "a"))) "A"))) (match:substring (string-match (rx (uncase (~ "a"))) "A")))
(not (string-match (rx (w/nocase (~ "a"))) "aA")) (not (string-match (rx (w/nocase (~ "a"))) "aA"))
(string-match (rx (w/nocase "abc" (string-match (rx (w/nocase "abc"
(* "FOO" (w/case "Bar")) (* "FOO" (w/case "Bar"))
("aeiou"))) ("aeiou")))
"kabcfooBariou") "kabcfooBariou")
(not (string-match (rx (w/nocase "abc" (not (string-match (rx (w/nocase "abc"
(* "FOO" (w/case "Bar")) (* "FOO" (w/case "Bar"))
("aeiou"))) ("aeiou")))
"kabcfooBARiou"))))) "kabcfooBARiou")))))
(add-test! 'dynamic-re-test-1 'pattern-matching (add-test! 'dynamic-re-test-1 'pattern-matching
(lambda () (lambda ()
(let ((str "I am feeding the goose, you are feeding the geese.") (let ((str "I am feeding the goose, you are feeding the geese.")
(me 1) (me 1)
(you 2)) (you 2))
(and (equal? "feeding the goose" (and (equal? "feeding the goose"
(match:substring (string-match (rx (: "feeding the " (match:substring (string-match (rx (: "feeding the "
,(if (> me 1) "geese" "goose"))) ,(if (> me 1)
str))) "geese"
(equal? "feeding the geese" "goose")))
(match:substring (string-match (rx (: "feeding the " str)))
,(if (> you 1) "geese" "goose"))) (equal? "feeding the geese"
str))))))) (match:substring (string-match (rx (: "feeding the "
,(if (> you 1)
"geese"
"goose")))
str)))))))
(add-test! 'dynamic-re-test-2 'pattern-matching (add-test! 'dynamic-re-test-2 'pattern-matching
(lambda () (lambda ()
(let* ((ws (rx (+ whitespace))) (let* ((ws (rx (+ whitespace)))
(date (rx (: (| "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul") (date (rx (: (| "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul")
,ws ,ws
(| ("123456789") (| ("123456789")
(: ("12") digit) (: ("12") digit)
"30" "30"
"31"))))) "31")))))
(and (equal? "on Mar 14" (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 ..."))))))) (equal? "on May 31"
(match:substring (string-match (rx (: "on " ,date))
"it was on May 31 ...")))))))
(add-test! 'regexp?-test 'pattern-matching (add-test! 'regexp?-test 'pattern-matching
(lambda () (lambda ()
(and (not (regexp? "abc")) (and (not (regexp? "abc"))
(regexp? (rx "abc"))))) (regexp? (rx "abc")))))
(add-test! 'regexp-search-test 'pattern-matching (add-test! 'regexp-search-test 'pattern-matching
(lambda () (lambda ()
(and (equal? "abc" (and (equal? "abc"
(match:substring (regexp-search (rx "abc") "abcdefg"))) (match:substring (regexp-search (rx "abc") "abcdefg")))
(not (regexp-search (rx "abc") "abcdefg" 3)) (not (regexp-search (rx "abc") "abcdefg" 3))
(not (regexp-search (rx "cba") "abcdefg"))))) (not (regexp-search (rx "cba") "abcdefg")))))
(add-test! 'regexp-search?-test 'pattern-matching (add-test! 'regexp-search?-test 'pattern-matching
(lambda () (lambda ()
(and (regexp-search? (rx "abc") "abcdefg") (and (regexp-search? (rx "abc") "abcdefg")
(not (regexp-search? (rx "abc") "abcdefg" 3)) (not (regexp-search? (rx "abc") "abcdefg" 3))
(not (regexp-search? (rx "cba") "abcdefg"))))) (not (regexp-search? (rx "cba") "abcdefg")))))
(add-test! 'regexp-substitute/global-test-1 'pattern-matching (add-test! 'regexp-substitute/global-test-1 'pattern-matching
(lambda () (lambda ()
(equal? "dry Jin" (equal? "dry Jin"
(regexp-substitute/global #f (rx "Cotton") "dry Cotton" (regexp-substitute/global #f (rx "Cotton") "dry Cotton"
'pre "Jin" 'post)))) 'pre "Jin" 'post))))
(add-test! 'regexp-substitute/global-test-2 'pattern-matching (add-test! 'regexp-substitute/global-test-2 'pattern-matching
(lambda () (lambda ()
(equal? "01/03/79" (equal? "01/03/79"
(regexp-substitute/global #f (rx (submatch (+ digit)) "/" (regexp-substitute/global #f (rx (submatch (+ digit)) "/"
(submatch (+ digit)) "/" (submatch (+ digit)) "/"
(submatch (+ digit))) (submatch (+ digit)))
"03/01/79" "03/01/79"
'pre 2 "/" 1 "/" 3 'post)))) 'pre 2 "/" 1 "/" 3 'post))))
(add-test! 'regexp-substitute/global-test-3 'pattern-matching (add-test! 'regexp-substitute/global-test-3 'pattern-matching
(lambda () (lambda ()
(equal? "Sep 29, 1961" (equal? "Sep 29, 1961"
(regexp-substitute/global #f (rx (submatch (+ digit)) "/" (regexp-substitute/global #f (rx (submatch (+ digit)) "/"
(submatch (+ digit)) "/" (submatch (+ digit)) "/"
(submatch (+ digit))) (submatch (+ digit)))
"9/29/61" "9/29/61"
'pre 'pre
(lambda (m) (lambda (m)
(let ((mon (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" (let ((mon (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec") "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
(- (string->number (match:substring m 1)) 1))) (- (string->number (match:substring m 1))
(day (match:substring m 2)) 1)))
(year (match:substring m 3))) (day (match:substring m 2))
(string-append mon " " day ", 19" year))) (year (match:substring m 3)))
'post)))) (string-append mon " " day ", 19" year)))
'post))))
(add-test! 'regexp-substitute/global-test-4 'pattern-matching (add-test! 'regexp-substitute/global-test-4 'pattern-matching
(lambda () (lambda ()
(let ((kill-matches (lambda (re s) (let ((kill-matches (lambda (re s)
(regexp-substitute/global #f re s 'pre 'post)))) (regexp-substitute/global #f re s 'pre 'post))))
(equal? " will disappear, also and " (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 (add-test! 'regexp-fold-right-test 'pattern-matching
(lambda () (lambda ()
(equal? (list "1" "1" "2" "2") (equal? (list "1" "1" "2" "2")
(regexp-fold-right (rx digit) (regexp-fold-right (rx digit)
(lambda (m i lis) (lambda (m i lis)
(cons (match:substring m 0) lis)) (cons (match:substring m 0) lis))
'() "a1 b1 a2 b2 ...")))) '() "a1 b1 a2 b2 ..."))))
(add-test! 'let-match-test 'pattern-matching (add-test! 'let-match-test 'pattern-matching
(lambda () (lambda ()
(equal? "3/1/79\nmonth: 3\nday: 1\nyear: 79" (equal? "3/1/79\nmonth: 3\nday: 1\nyear: 79"
(let-match (regexp-search (rx (submatch (+ digit)) "/" (let-match (regexp-search (rx (submatch (+ digit)) "/"
(submatch (+ digit)) "/" (submatch (+ digit)) "/"
(submatch (+ digit))) (submatch (+ digit)))
"here comes a date: 3/1/79") "here comes a date: 3/1/79")
(whole-date month day year) (whole-date month day year)
(string-append whole-date "\nmonth: " month "\nday: " day "\nyear: " 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 (add-test! 'sre->regexp-test 'pattern-matching
(lambda () (lambda ()
(regexp? (sre->regexp '(: "Christoph " (? "F. ") "Hetz"))))) (regexp? (sre->regexp '(: "Christoph " (? "F. ") "Hetz")))))
;; XXX
;;Warning: wrong number of arguments ;;Warning: wrong number of arguments
;; (re-seq (re-string "Pete ") (re-repeat 1 #f (re-string "Sz")) (re-string "ilagyi")) ;; (re-seq (re-string "Pete ") (re-repeat 1 #f (re-string "Sz")) (re-string "ilagyi"))
;; (procedure wants: (:value)) ;; (procedure wants: (:value))
@ -301,13 +527,9 @@
;; ;;
;; ;;
;(add-test! 'regexp->sre-test 'pattern-matching ;(add-test! 'regexp->sre-test 'pattern-matching
; (lambda () ; (lambda ()
; (equal? '(? "Pete" (+ "Sz") "ilagyi") ; (equal? '(? "Pete" (+ "Sz") "ilagyi")
; (regexp->sre (re-repeat 0 1 (re-seq (re-string "Pete ") ; (regexp->sre (re-repeat 0 1 (re-seq (re-string "Pete ")
; (re-repeat 1 #f (re-string "Sz")) ; (re-repeat 1 #f (re-string "Sz"))
; (re-string "ilagyi"))))))) ; (re-string "ilagyi")))))))

540
scsh/test/read-delimited-strings.scm
View File

@ -11,330 +11,360 @@
(add-test! 'read-line-test 'reading-delimited-strings (add-test! 'read-line-test 'reading-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-line in-port)) (read-line in-port))
(equal? "zeile 2" (equal? "zeile 2"
(read-line in-port)) (read-line in-port))
(equal? "zeile 3" (equal? "zeile 3"
(read-line in-port)))) (read-line in-port))))
(make-string-input-port "zeile 1\nzeile 2\nzeile 3")))) (make-string-input-port "zeile 1\nzeile 2\nzeile 3"))))
(add-test! 'read-line-trim-test 'reading-delimited-strings ;; same as without trim (add-test! 'read-line-trim-test 'reading-delimited-strings ;; same as without trim
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-line in-port 'trim)) (read-line in-port 'trim))
(equal? "zeile 2" (equal? "zeile 2"
(read-line in-port 'trim)) (read-line in-port 'trim))
(equal? "zeile 3" (equal? "zeile 3"
(read-line in-port 'trim)))) (read-line in-port 'trim))))
(make-string-input-port "zeile 1\nzeile 2\nzeile 3")))) (make-string-input-port "zeile 1\nzeile 2\nzeile 3"))))
(add-test! 'read-line-peek-test 'reading-delimited-strings (add-test! 'read-line-peek-test 'reading-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-line in-port 'peek)) (read-line in-port 'peek))
(equal? "" (equal? ""
(read-line in-port 'peek)) (read-line in-port 'peek))
(equal? "" (equal? ""
(read-line in-port 'peek)))) (read-line in-port 'peek))))
(make-string-input-port "zeile 1\nzeile 2\nzeile 3")))) (make-string-input-port "zeile 1\nzeile 2\nzeile 3"))))
(add-test! 'read-line-concat-test 'reading-delimited-strings (add-test! 'read-line-concat-test 'reading-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1\n" (and (equal? "zeile 1\n"
(read-line in-port 'concat)) (read-line in-port 'concat))
(equal? "zeile 2\n" (equal? "zeile 2\n"
(read-line in-port 'concat)) (read-line in-port 'concat))
(equal? "zeile 3\004" (equal? "zeile 3\004"
(read-line in-port 'concat)))) (read-line in-port 'concat))))
(make-string-input-port "zeile 1\nzeile 2\nzeile 3\004")))) (make-string-input-port "zeile 1\nzeile 2\nzeile 3\004"))))
(add-test! 'read-line-split-test 'reading-delimited-strings ;; XXX warum #\newline und nicht "\n"??? (add-test! 'read-line-split-test 'reading-delimited-strings ;; XXX warum #\newline und nicht "\n"???
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (call-with-values (lambda () (read-line in-port 'split)) (and (call-with-values (lambda () (read-line in-port 'split))
(lambda (a b) (and (equal? a "zeile 1") (lambda (a b) (and (equal? a "zeile 1")
(equal? b #\newline)))) (equal? b #\newline))))
(call-with-values (lambda () (read-line in-port 'split)) (call-with-values (lambda () (read-line in-port 'split))
(lambda (a b) (and (equal? a "zeile 2") (lambda (a b) (and (equal? a "zeile 2")
(equal? b #\newline)))) (equal? b #\newline))))
(call-with-values (lambda () (read-line in-port 'split)) (call-with-values (lambda () (read-line in-port 'split))
(lambda (a b) (and (equal? a "zeile 3") (lambda (a b) (and (equal? a "zeile 3")
(equal? b "\004")))))) ;; XXX geht nicht mit "\004" und nicht mit (ascii->char 4)! (equal? b "\004")))))) ;; XXX geht nicht mit "\004" und nicht mit (ascii->char 4)!
(make-string-input-port "zeile 1\nzeile 2\nzeile 3\004")))) (make-string-input-port "zeile 1\nzeile 2\nzeile 3\004"))))
(add-test! 'read-paragraph-test 'reading-delimited-strings (add-test! 'read-paragraph-test 'reading-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1\nzeile 2\nparagraph 1\n" (and (equal? "zeile 1\nzeile 2\nparagraph 1\n"
(read-paragraph in-port)) (read-paragraph in-port))
(equal? "zeile 1\nparagraph 2\n" (equal? "zeile 1\nparagraph 2\n"
(read-paragraph in-port)) (read-paragraph in-port))
(equal? "zeile 1\nparagraph 3\n" (equal? "zeile 1\nparagraph 3\n"
(read-paragraph in-port)))) (read-paragraph in-port))))
(make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n")))) (make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n"))))
(add-test! 'read-paragraph-trim-test 'reading-delimited-strings ;; same as without trim (add-test! 'read-paragraph-trim-test 'reading-delimited-strings ;; same as without trim
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1\nzeile 2\nparagraph 1\n" (and (equal? "zeile 1\nzeile 2\nparagraph 1\n"
(read-paragraph in-port 'trim)) (read-paragraph in-port 'trim))
(equal? "zeile 1\nparagraph 2\n" (equal? "zeile 1\nparagraph 2\n"
(read-paragraph in-port 'trim)) (read-paragraph in-port 'trim))
(equal? "zeile 1\nparagraph 3\n" (equal? "zeile 1\nparagraph 3\n"
(read-paragraph in-port 'trim)))) (read-paragraph in-port 'trim))))
(make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n")))) (make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n"))))
(add-test! 'read-paragraph-concat-test 'reading-delimited-strings (add-test! 'read-paragraph-concat-test 'reading-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1\nzeile 2\nparagraph 1\n\n" (and (equal? "zeile 1\nzeile 2\nparagraph 1\n\n"
(read-paragraph in-port 'concat)) (read-paragraph in-port 'concat))
(equal? "zeile 1\nparagraph 2\n \t\n" (equal? "zeile 1\nparagraph 2\n \t\n"
(read-paragraph in-port 'concat)) (read-paragraph in-port 'concat))
(equal? "zeile 1\nparagraph 3\n\n" (equal? "zeile 1\nparagraph 3\n\n"
(read-paragraph in-port 'concat)))) (read-paragraph in-port 'concat))))
(make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n")))) (make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n"))))
(add-test! 'read-paragraph-split-test 'reading-delimited-strings (add-test! 'read-paragraph-split-test 'reading-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (call-with-values (lambda () (read-paragraph in-port 'split)) (and (call-with-values (lambda () (read-paragraph in-port 'split))
(lambda (a b) (lambda (a b)
; (display "a1: ")(display a) ; (display "a1: ")(display a)
; (display "b1: ")(display b) ; (display "b1: ")(display b)
(and (equal? a "zeile 1\nzeile 2\nparagraph 1\n") (and (equal? a "zeile 1\nzeile 2\nparagraph 1\n")
(equal? b "\n")))) (equal? b "\n"))))
(call-with-values (lambda () (read-paragraph in-port 'split)) (call-with-values (lambda () (read-paragraph in-port 'split))
(lambda (a b) (lambda (a b)
; (display "a2: ")(display a) ; (display "a2: ")(display a)
; (display "b2: ")(display b) ; (display "b2: ")(display b)
(and (equal? a "zeile 1\nparagraph 2\n") (and (equal? a "zeile 1\nparagraph 2\n")
(equal? b " \t\n")))) (equal? b " \t\n"))))
(call-with-values (lambda () (read-paragraph in-port 'split)) (call-with-values (lambda () (read-paragraph in-port 'split))
(lambda (a b) (lambda (a b)
; (display "a3: ")(display a) ; (display "a3: ")(display a)
; (display "b3: ")(display b) ; (display "b3: ")(display b)
(and (equal? a "zeile 1\nparagraph 3\n") (and (equal? a "zeile 1\nparagraph 3\n")
(equal? b "\n")))))) (equal? b "\n"))))))
(make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n")))) (make-string-input-port "zeile 1\nzeile 2\nparagraph 1\n\nzeile 1\nparagraph 2\n \t\nzeile 1\nparagraph 3\n\n"))))
(add-test! 'read-delimited-with-char-set-test 'read-delimited-strings (add-test! 'read-delimited-with-char-set-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited (list->char-set (list #\a #\b #\:)) in-port)) (read-delimited (list->char-set (list #\a #\b #\:)) in-port))
(equal? " nix\nzeile 2: x" (equal? " nix\nzeile 2: x"
(read-delimited (list->char-set (list #\a #\b #\y)) in-port)))) (read-delimited (list->char-set (list #\a #\b #\y)) in-port))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-trim-with-char-set-test 'read-delimited-strings (add-test! 'read-delimited-trim-with-char-set-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited (list->char-set (list #\a #\b #\:)) in-port 'trim)) (read-delimited (list->char-set (list #\a #\b #\:)) in-port 'trim))
(equal? " nix\nzeile 2: x" (equal? " nix\nzeile 2: x"
(read-delimited (list->char-set (list #\a #\b #\y)) in-port 'trim)))) (read-delimited (list->char-set (list #\a #\b #\y)) in-port 'trim))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-peek-with-char-set-test 'read-delimited-strings (add-test! 'read-delimited-peek-with-char-set-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited (list->char-set (list #\a #\b #\:)) in-port 'peek)) (read-delimited (list->char-set (list #\a #\b #\:)) in-port 'peek))
(equal? ": nix\nzeile 2: x" (equal? ": nix\nzeile 2: x"
(read-delimited (list->char-set (list #\a #\b #\y)) in-port 'peek)))) (read-delimited (list->char-set (list #\a #\b #\y)) in-port 'peek))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-concat-with-char-set-test 'read-delimited-strings (add-test! 'read-delimited-concat-with-char-set-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1:" (and (equal? "zeile 1:"
(read-delimited (list->char-set (list #\a #\b #\:)) in-port 'concat)) (read-delimited (list->char-set (list #\a #\b #\:)) in-port 'concat))
(equal? " nix\nzeile 2: xy" (equal? " nix\nzeile 2: xy"
(read-delimited (list->char-set (list #\a #\b #\y)) in-port 'concat)))) (read-delimited (list->char-set (list #\a #\b #\y)) in-port 'concat))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-split-with-char-set-test 'read-delimited-strings (add-test! 'read-delimited-split-with-char-set-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (call-with-values (and (call-with-values
(lambda () (read-delimited (list->char-set (list #\a #\b #\:)) in-port 'split)) (lambda () (read-delimited (list->char-set (list #\a #\b #\:)) in-port 'split))
(lambda (a b) (and (equal? "zeile 1" a) (lambda (a b) (and (equal? "zeile 1" a)
(equal? #\: b)))) (equal? #\: b))))
(call-with-values (call-with-values
(lambda () (read-delimited (list->char-set (list #\a #\b #\y)) in-port 'split)) (lambda () (read-delimited (list->char-set (list #\a #\b #\y)) in-port 'split))
(lambda (a b) (and (equal? " nix\nzeile 2: x" a) (lambda (a b) (and (equal? " nix\nzeile 2: x" a)
(equal? #\y b)))))) (equal? #\y b))))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
;;------------------------------------------------------------------------------------------------------------------------ ;;------------------------------------------------------------------------------------------------------------------------
(add-test! 'read-delimited-with-string-test 'read-delimited-strings (add-test! 'read-delimited-with-string-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited "ab:" in-port)) (read-delimited "ab:" in-port))
(equal? " nix\nzeile 2: x" (equal? " nix\nzeile 2: x"
(read-delimited "aby" in-port)))) (read-delimited "aby" in-port))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-trim-with-string-test 'read-delimited-strings (add-test! 'read-delimited-trim-with-string-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited "ab:" in-port 'trim)) (read-delimited "ab:" in-port 'trim))
(equal? " nix\nzeile 2: x" (equal? " nix\nzeile 2: x"
(read-delimited "aby" in-port 'trim)))) (read-delimited "aby" in-port 'trim))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-peek-with-string-test 'read-delimited-strings (add-test! 'read-delimited-peek-with-string-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited "ab:" in-port 'peek)) (read-delimited "ab:" in-port 'peek))
(equal? ": nix\nzeile 2: x" (equal? ": nix\nzeile 2: x"
(read-delimited "aby" in-port 'peek)))) (read-delimited "aby" in-port 'peek))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-concat-with-string-test 'read-delimited-strings (add-test! 'read-delimited-concat-with-string-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1:" (and (equal? "zeile 1:"
(read-delimited "ab:" in-port 'concat)) (read-delimited "ab:" in-port 'concat))
(equal? " nix\nzeile 2: xy" (equal? " nix\nzeile 2: xy"
(read-delimited "aby" in-port 'concat)))) (read-delimited "aby" in-port 'concat))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-split-with-string-test 'read-delimited-strings (add-test! 'read-delimited-split-with-string-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (call-with-values (and (call-with-values
(lambda () (read-delimited "ab:" in-port 'split)) (lambda () (read-delimited "ab:" in-port 'split))
(lambda (a b) (and (equal? "zeile 1" a) (lambda (a b) (and (equal? "zeile 1" a)
(equal? #\: b)))) (equal? #\: b))))
(call-with-values (call-with-values
(lambda () (read-delimited "aby" in-port 'split)) (lambda () (read-delimited "aby" in-port 'split))
(lambda (a b) (and (equal? " nix\nzeile 2: x" a) (lambda (a b) (and (equal? " nix\nzeile 2: x" a)
(equal? #\y b)))))) (equal? #\y b))))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
(add-test! 'read-delimited-with-character-test 'read-delimited-strings (add-test! 'read-delimited-with-character-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited #\: in-port)) (read-delimited #\: in-port))
(equal? " nix\nzeile 2: x" (equal? " nix\nzeile 2: x"
(read-delimited #\y in-port)))) (read-delimited #\y in-port))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-trim-with-character-test 'read-delimited-strings (add-test! 'read-delimited-trim-with-character-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited #\: in-port 'trim)) (read-delimited #\: in-port 'trim))
(equal? " nix\nzeile 2: x" (equal? " nix\nzeile 2: x"
(read-delimited #\y in-port 'trim)))) (read-delimited #\y in-port 'trim))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-peek-with-character-test 'read-delimited-strings (add-test! 'read-delimited-peek-with-character-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1" (and (equal? "zeile 1"
(read-delimited #\: in-port 'peek)) (read-delimited #\: in-port 'peek))
(equal? ": nix\nzeile 2: x" (equal? ": nix\nzeile 2: x"
(read-delimited #\y in-port 'peek)))) (read-delimited #\y in-port 'peek))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-concat-with-character-test 'read-delimited-strings (add-test! 'read-delimited-concat-with-character-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile 1:" (and (equal? "zeile 1:"
(read-delimited #\: in-port 'concat)) (read-delimited #\: in-port 'concat))
(equal? " nix\nzeile 2: xy" (equal? " nix\nzeile 2: xy"
(read-delimited #\y in-port 'concat)))) (read-delimited #\y in-port 'concat))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
(add-test! 'read-delimited-split-with-character-test 'read-delimited-strings (add-test! 'read-delimited-split-with-character-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (call-with-values (and (call-with-values
(lambda () (read-delimited #\: in-port 'split)) (lambda () (read-delimited #\: in-port 'split))
(lambda (a b) (and (equal? "zeile 1" a) (lambda (a b) (and (equal? "zeile 1" a)
(equal? #\: b)))) (equal? #\: b))))
(call-with-values (call-with-values
(lambda () (read-delimited #\y in-port 'split)) (lambda () (read-delimited #\y in-port 'split))
(lambda (a b) (and (equal? " nix\nzeile 2: x" a) (lambda (a b) (and (equal? " nix\nzeile 2: x" a)
(equal? #\y b)))))) (equal? #\y b))))))
(make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n")))) (make-string-input-port "zeile 1: nix\nzeile 2: xy\nzeile 3: wieder nix\n"))))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
(add-test! 'read-delimited-with-character-predicate-test 'read-delimited-strings (add-test! 'read-delimited-with-character-predicate-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile a" (and (equal? "zeile a"
(read-delimited char-digit? in-port)) (read-delimited char-digit? in-port))
(equal? " nix\nzeile b1 x" (equal? " nix\nzeile b1 x"
(read-delimited char-digit? in-port)))) (read-delimited char-digit? in-port))))
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))) (make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n"))))
(add-test! 'read-delimited-trim-with-character-predicate-test 'read-delimited-strings (add-test! 'read-delimited-trim-with-character-predicate-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile a" (and (equal? "zeile a"
(read-delimited char-digit? in-port 'trim)) (read-delimited char-digit? in-port 'trim))
(equal? " nix\nzeile b1 x" (equal? " nix\nzeile b1 x"
(read-delimited char-digit? in-port 'trim)))) (read-delimited char-digit? in-port 'trim))))
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))) (make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n"))))
(add-test! 'read-delimited-peek-with-character-predicate-test 'read-delimited-strings (add-test! 'read-delimited-peek-with-character-predicate-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile a" (and (equal? "zeile a"
(read-delimited char-digit? in-port 'peek)) (read-delimited char-digit? in-port 'peek))
(equal? "1 nix\nzeile b1 x" (equal? "1 nix\nzeile b1 x"
(read-delimited char-digit? in-port 'peek)))) (read-delimited char-digit? in-port 'peek))))
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))) (make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n"))))
(add-test! 'read-delimited-concat-with-character-predicate-test 'read-delimited-strings (add-test! 'read-delimited-concat-with-character-predicate-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (equal? "zeile a1" (and (equal? "zeile a1"
(read-delimited char-digit? in-port 'concat)) (read-delimited char-digit? in-port 'concat))
(equal? " nix\nzeile b1 x2" (equal? " nix\nzeile b1 x2"
(read-delimited char-digit? in-port 'concat)))) (read-delimited char-digit? in-port 'concat))))
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))) (make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n"))))
(add-test! 'read-delimited-split-with-character-predicate-test 'read-delimited-strings (add-test! 'read-delimited-split-with-character-predicate-test 'read-delimited-strings
(lambda () (lambda ()
((lambda (in-port) ((lambda (in-port)
(and (call-with-values (and (call-with-values
(lambda () (read-delimited char-digit? in-port 'split)) (lambda () (read-delimited char-digit? in-port 'split))
(lambda (a b) (and (equal? "zeile a" a) (lambda (a b) (and (equal? "zeile a" a)
(equal? #\1 b)))) (equal? #\1 b))))
(call-with-values (call-with-values
(lambda () (read-delimited char-digit? in-port 'split)) (lambda () (read-delimited char-digit? in-port 'split))
(lambda (a b) (and (equal? " nix\nzeile b1 x" a) (lambda (a b) (and (equal? " nix\nzeile b1 x" a)
(equal? #\2 b)))))) (equal? #\2 b))))))
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n")))) (make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n"))))
;; =============================================================================================== ;; ===============================================================================================
(add-test! 'read-delimited!-with-char-set-test 'read-delimited-strings
(lambda () ;; XXX read-delimited! and %read-delimited! are confusing bugy
(let ((buf " ")) ;(add-test! 'read-delimited!-with-char-set-test 'read-delimited-strings
((lambda (in-port) ; (lambda ()
(read-delimited! (list->char-set (list #\a #\b #\1)) ; (let ((buf " "))
buf ; ((lambda (in-port)
in-port) ; (read-delimited! (list->char-set (list #\a #\b #\1))
(equal? "zeile a " ; buf
buf)) ; in-port)
(make-string-input-port "zeile a1 nix\nzeile b1 x2\nzeile c1 wieder nix\n"))))) ; (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 ()
(= 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")))))