posix-regex

 1(import (r7rs) (test) (posix-regex))
 2
 3(define (test-match pattern string . options)
 4  (regex-match?
 5    (apply make-regex (append (list pattern) options))
 6    string))
 7
 8(define (test-exec pattern string)
 9  (regex-exec
10    (make-regex pattern)
11    (string->utf8 string)))
12
13;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14
15(test-group "make-regex"
16  (test-assert "literal string" (regex? (make-regex "foo")))
17  (test-assert "ignorecase" (regex? (make-regex "foobar" #t)))
18  (test-assert "extended regular expression" (regex? (make-regex "[0-9]+" #f #t)))
19  (test-assert "newline option" (regex? (make-regex "foo" #f #f #t)))
20
21  (test-error "invalid interval expression" (make-regex "\\{foo,foo\\}")) ;; REG_BADAR
22  (test-error "parentheses imbalance" (make-regex "\\(foo"))              ;; REG_EBRACE
23  (test-error "bracket imbalance" (make-regex "["))                       ;; REG_EBRACK
24  (test-error "trailing backslash" (make-regex "\\")))                    ;; REG_EESCAPE
25
26(test-group "regex-match?"
27  (test "match literal string" #t (test-match "foo" "foo"))
28  (test "don't match literal string" #f (test-match "foo" "bar"))
29  (test "partially match literal string" #t (test-match "foo" "foobar"))
30  (test "match bracket expression" #t (test-match "f[a-z][a-z]b" "foobar"))
31  (test "match repeated expression" #t (test-match "a*b" "aaaaab"))
32  (test "match start and end" #f (test-match "^foo$" "|foo|"))
33  (test "multiline mode" #t (test-match "^foo" "bar\nfoo\n" #f #f #t))
34  (test "non-multiline mode" #f (test-match "^foo" "bar\nfoo\n")))
35
36(test-group "regex-exec"
37  (test "match literal string"
38        #((0 . 3))
39        (test-exec "foo" "foo"))
40
41  (test "not matching"
42        #f
43        (test-exec "foo" "bar"))
44
45  (test "match single submatch"
46        #((0 . 13) (5 . 8))
47        (test-exec "foo |\\(..*\\)| baz" "foo |bar| baz"))
48
49  (test "match zero-length string"
50        #((0 . 10) (5 . 5))
51        (test-exec "foo '\\(.*\\)' baz" "foo '' baz"))
52
53  (test "non-participating submatch"
54        #((0 . 8) #f (5 . 8))
55        (test-exec "foo \\(..*\\)* \\(..*\\)" "foo  baz")))
56
57;; Exit with non-zero exit status if some test failed.
58(test-exit)