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

new tests

This commit is contained in:
chetz 2004-09-05 16:59:43 +00:00
parent 99f77e2c06
commit 027ce1b9d7
1 changed files with 125 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -532,12 +532,13 @@
;; (arguments are: (:value :value :value))
;;
;;
;(add-test! 'regexp->sre-test 'pattern-matching
; (lambda ()
; (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")))))))
(add-test! 'regexp->sre-test 'pattern-matching
(lambda ()
(let ((re (re-seq (list (re-string "Pete ")
(re-repeat 1 #f (re-string "Sz"))
(re-string "ilagyi")))))
(equal? '(? "Pete " (+ "Sz") "ilagyi")
(regexp->sre (re-repeat 0 1 re))))))
(add-test! 'char-classes+algebra-test 'pattern-matching
(lambda ()
@ -595,3 +596,121 @@
(string-match (rx (* alphanumeric)) "xxxabcdexxx"))
(eq-match? (string-match (rx (: "xxx" (: "abcde" "x" "xx"))) "xxxabcdexxx")
(string-match (rx (* (| (/ "ae") "x"))) "xxxabcdexxx")))))
(add-test! 'regexp-adt-re-seq-test 'pattern-matching
(lambda ()
(and (re-seq? (make-re-seq '("foo" "bar")))
(re-seq? (re-seq '("foo" "bar")))
(equal? '("foo" "bar")
(re-seq:elts (make-re-seq '("foo" "bar"))))
(= 2
(re-seq:tsm (rx (: (submatch "foo")
(submatch "bar"))))))))
(add-test! 'regexp-adt-re-choice-test 'pattern-matching
(lambda ()
(and (re-choice? (make-re-choice '("foo" "bar")))
(re-choice? (re-choice '("foo" "bar")))
(equal? '("foo" "bar")
(re-choice:elts (make-re-choice '("foo" "bar"))))
(= 2
(re-choice:tsm (rx (| (submatch "foo")
(submatch "bar"))))))))
(add-test! 'regexp-adt-re-repeat-test 'pattern-matching
(lambda ()
(and (re-repeat? (make-re-repeat 1 5 '("foo" "bar")))
(= 1
(re-repeat:from (make-re-repeat 1 5 '("foo" "bar"))))
(= 5
(re-repeat:to (make-re-repeat 1 5 '("foo" "bar"))))
(= 2
(re-repeat:tsm (rx (** 1 5 (submatch "foo")
(submatch "bar"))))))))
(add-test! 'regexp-adt-re-submatch-test 'pattern-matching
(lambda ()
(and (re-submatch? (make-re-submatch (rx "foo")))
(= 1
(re-submatch:pre-dsm (make-re-submatch (rx "foo") 1 0)))
(= 0
(re-submatch:post-dsm (make-re-submatch (rx "foo") 1 0)))
(= 3
(re-submatch:tsm (rx (submatch (submatch "foo")
(submatch "bar"))))))))
(add-test! 'regexp-adt-re-string-test 'pattern-matching
(lambda ()
(and (re-string? (make-re-string "abc"))
(re-string? (re-string "abc"))
(equal? "abc"
(re-string:chars (rx "abc"))))))
(add-test! 'regexp-adt-re-char-set-test 'pattern-matching
(lambda ()
(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
(make-re-char-set (list->char-set (list #\a #\b #\c)))))))))
(add-test! 'regexp-adt-re-dsm-test 'pattern-matching
(lambda ()
(and (re-dsm? (make-re-dsm (rx "foo") 1 0))
;XXX (re-dsm? (re-dsm (rx "foo") 1 0))
(re-string? (re-dsm:body (make-re-dsm (rx "foo") 1 0)))
(= 1
(re-dsm:pre-dsm (make-re-dsm (rx "foo") 1 0)))
(= 0
(re-dsm:post-dsm (make-re-dsm (rx "foo") 1 0)))
(= 1
(re-dsm:tsm (make-re-dsm (rx "foo") 1 0))))))
(add-test! 'regexp-adt-re-const-test 'pattern-matching
(lambda ()
(and (regexp? re-bos)
(regexp? re-eos)
(regexp? re-bol)
(regexp? re-eol)
(re-bos? re-bos)
(re-eos? re-eos)
(re-bol? re-bol)
(re-eol? re-eol))))
(add-test! 'regexp-adt-re-const-2-test 'pattern-matching
(lambda ()
(and (regexp? re-trivial)
(re-trivial? re-trivial)
(regexp? re-empty)
(re-empty? re-empty)
(regexp? re-any)
(re-any? re-any)
(regexp? re-nonl)
(= 3
(re-tsm (rx (submatch (submatch "foo")
(submatch "bar")))))
;; XXX clean-up-cres
(matches-same-signs? re-any (rx any))
(matches-same-signs? re-nonl (rx (~ #\newline)))
(matches-same-signs? re-empty (rx (|)))
;; XXX error - but why?
;; (matches-same-signs? re-trivial (rx ""))
)))
;(add-test! 'if-sre-form-test 'pattern-matching
; (lambda ()
; (let* ((sr '(: "a" "b")))
; (rgxp (rx sr)))
; (and (regexp? (if-sre-form sr
; (rx se)
; sr))
; (regexp? (if-sre-form rgxp
; (rx rgxp)
; rgxp))))))
;(add-test! 'sre-form?-test 'pattern-matching
; (lambda ()
; (let* ((sr '(: "a" "b"))
; (rgxp (rx sr)))
; (and (not (sre-form? rgxp))
; (sre-form sr)))))