source: project/chicken/trunk/tests/test-irregex.scm @ 12920

Last change on this file since 12920 was 12920, checked in by felix winkelmann, 11 years ago

irregex merge; -ignore-repository disables dloading; extension-version fix for chicken-install (reported by Peter Bex); compiler export/blockmode fix; updated bootstrapping tarball

File size: 2.4 KB
Line 
1;;;: test-irregex.scm
2
3
4(use extras regex)
5
6(include "test.scm")
7
8(import irregex)
9
10(define (subst-matches matches subst)
11  (define (submatch n)
12    (if (vector? matches)
13        (irregex-match-substring matches n)
14        (list-ref matches n)))
15  (and
16   matches
17   (call-with-output-string
18     (lambda (out)
19       (call-with-input-string subst
20         (lambda (in)
21           (let lp ()
22             (let ((c (read-char in)))
23               (cond
24                ((not (eof-object? c))
25                 (case c
26                   ((#\&)
27                    (display (or (submatch 0) "") out))
28                   ((#\\)
29                    (let ((c (read-char in)))
30                      (if (char-numeric? c)
31                          (display
32                           (or (submatch (string->number (string c))) "")
33                           out)
34                          (write-char c out))))
35                   (else
36                    (write-char c out)))
37                 (lp)))))))))))
38
39(define (test-re matcher line)
40  (apply
41   (lambda (pattern input result subst output)
42     (let ((name (sprintf "~A  ~A  ~A" pattern input result)))
43       (cond
44        ((equal? "c" result)
45         (test-error name (matcher pattern input)))
46        ((equal? "n" result)
47         (test-assert name (not (matcher pattern input))))
48        ((equal? "y" result)
49         (test-assert name (matcher pattern input)))
50        (else
51         (test-equal name
52                     (subst-matches (matcher pattern input) subst)
53                     result)))))
54   (string-split line "\t" #t)))
55
56
57(test-begin)
58
59;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60
61(for-each
62 (lambda (opts)
63   (test-group (sprintf "irregex - ~S" opts)
64     (with-input-from-file "re-tests.txt"
65       (lambda ()
66         (port-for-each
67          (lambda (line)
68            (test-re (lambda (pat str)
69                       (irregex-search (apply irregex pat opts) str))
70                     line))
71          read-line)))))
72 '((small) (fast)))
73
74(test-group "regex"
75   (with-input-from-file "re-tests.txt"
76     (lambda ()
77       (port-for-each
78        (lambda (line) (test-re string-search line))
79        read-line))))
80
81;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82
83(test-group "utils"
84  (test-equal "replace" 
85      (irregex-replace "[aeiou]" "hello world" "*")
86      "h*llo world")
87  (test-equal "replace/all"
88      (irregex-replace/all "[aeiou]" "hello world" "*")
89      "h*ll* w*rld"))
90
91(test-end)
92(test-exit)
93
Note: See TracBrowser for help on using the repository browser.