AtlatestRepositorysigil-peg

sigil-peg / tree / testtest-peg.sgl

1(import (sigil test)
2 (sigil peg))
3
4;; ============================================================
5;; Atomic Patterns
6;; ============================================================
7
8(test-group "literal strings"
9 (test "match exact string"
10 (let ((m (peg/match "hello" "hello world")))
11 (assert-true (peg-match? m))
12 (assert-equal 0 (peg-match-start m))
13 (assert-equal 5 (peg-match-end m))))
15 (test "fail on mismatch"
16 (assert-false (peg/match "xyz" "hello")))
18 (test "fail on too short"
19 (assert-false (peg/match "hello world!" "hello")))
21 (test "empty string always matches"
22 (let ((m (peg/match "" "hello")))
23 (assert-true (peg-match? m))
24 (assert-equal 0 (peg-match-end m)))))
26(test-group "literal characters"
27 (test "match character"
28 (let ((m (peg/match #\h "hello")))
29 (assert-true (peg-match? m))
30 (assert-equal 1 (peg-match-end m))))
32 (test "fail on wrong character"
33 (assert-false (peg/match #\x "hello"))))
35(test-group "any-char"
36 (test "matches any character"
37 (let ((m (peg/match 'any-char "x")))
38 (assert-true (peg-match? m))
39 (assert-equal 1 (peg-match-end m))))
41 (test "fails on empty input"
42 (assert-false (peg/match 'any-char ""))))
44(test-group "char-range"
45 (test "match character in range"
46 (assert-true (peg-match? (peg/match '(char-range #\a #\z) "hello"))))
48 (test "fail on character outside range"
49 (assert-false (peg/match '(char-range #\a #\z) "Hello")))
51 (test "match boundary characters"
52 (assert-true (peg-match? (peg/match '(char-range #\a #\z) "a")))
53 (assert-true (peg-match? (peg/match '(char-range #\a #\z) "z")))))
55(test-group "char-set"
56 (test "match alphabetic"
57 (assert-true (peg-match? (peg/match '(char-set char-alphabetic?) "a"))))
59 (test "fail alphabetic on digit"
60 (assert-false (peg/match '(char-set char-alphabetic?) "1")))
62 (test "match numeric"
63 (assert-true (peg-match? (peg/match '(char-set char-numeric?) "5"))))
65 (test "match whitespace"
66 (assert-true (peg-match? (peg/match '(char-set char-whitespace?) " ")))))
68;; ============================================================
69;; Combinators
70;; ============================================================
72(test-group "seq"
73 (test "sequence of literals"
74 (let ((m (peg/match '(seq "hello" " " "world") "hello world")))
75 (assert-true (peg-match? m))
76 (assert-equal 11 (peg-match-end m))))
78 (test "fail if any part fails"
79 (assert-false (peg/match '(seq "hello" " " "earth") "hello world"))))
81(test-group "ordered choice"
82 (test "first alternative matches"
83 (let ((m (peg/match '(/ "hello" "world") "hello")))
84 (assert-true (peg-match? m))
85 (assert-equal 5 (peg-match-end m))))
87 (test "second alternative matches"
88 (let ((m (peg/match '(/ "hello" "world") "world")))
89 (assert-true (peg-match? m))
90 (assert-equal 5 (peg-match-end m))))
92 (test "fail if none match"
93 (assert-false (peg/match '(/ "hello" "world") "foo"))))
95(test-group "zero or more"
96 (test "matches multiple"
97 (let ((m (peg/match '(* #\a) "aaa")))
98 (assert-true (peg-match? m))
99 (assert-equal 3 (peg-match-end m))))
101 (test "matches zero"
102 (let ((m (peg/match '(* #\a) "bbb")))
103 (assert-true (peg-match? m))
104 (assert-equal 0 (peg-match-end m))))
106 (test "greedy matching"
107 (let ((m (peg/match '(* (char-set char-alphabetic?)) "hello123")))
108 (assert-true (peg-match? m))
109 (assert-equal 5 (peg-match-end m)))))
111(test-group "one or more"
112 (test "matches multiple"
113 (let ((m (peg/match '(+ #\a) "aaa")))
114 (assert-true (peg-match? m))
115 (assert-equal 3 (peg-match-end m))))
117 (test "fails on zero"
118 (assert-false (peg/match '(+ #\a) "bbb"))))
120(test-group "optional"
121 (test "matches when present"
122 (let ((m (peg/match '(seq (? "-") (+ (char-set char-numeric?))) "-42")))
123 (assert-true (peg-match? m))
124 (assert-equal 3 (peg-match-end m))))
126 (test "succeeds when absent"
127 (let ((m (peg/match '(seq (? "-") (+ (char-set char-numeric?))) "42")))
128 (assert-true (peg-match? m))
129 (assert-equal 2 (peg-match-end m)))))
131(test-group "negative lookahead"
132 (test "succeeds when pattern does not match"
133 (let ((m (peg/match '(seq (! "x") any-char) "abc")))
134 (assert-true (peg-match? m))
135 (assert-equal 1 (peg-match-end m))))
137 (test "fails when pattern matches"
138 (assert-false (peg/match '(seq (! "a") any-char) "abc"))))
140(test-group "positive lookahead"
141 (test "succeeds without consuming"
142 (let ((m (peg/match '(seq (& "hello") "hello") "hello")))
143 (assert-true (peg-match? m))
144 (assert-equal 5 (peg-match-end m))))
146 (test "fails when pattern does not match"
147 (assert-false (peg/match '(& "world") "hello"))))
149(test-group "to"
150 (test "match up to target"
151 (let ((m (peg/match '(seq (to ".") ".") "hello.world")))
152 (assert-true (peg-match? m))
153 (assert-equal 6 (peg-match-end m))))
155 (test "fail if target not found"
156 (assert-false (peg/match '(seq (to ".") ".") "hello"))))
158(test-group "thru"
159 (test "match through target"
160 (let ((m (peg/match '(thru ".") "hello.world")))
161 (assert-true (peg-match? m))
162 (assert-equal 6 (peg-match-end m)))))
164(test-group "between"
165 (test "match exactly min"
166 (let ((m (peg/match '(between 2 4 #\a) "aa")))
167 (assert-true (peg-match? m))
168 (assert-equal 2 (peg-match-end m))))
170 (test "match up to max"
171 (let ((m (peg/match '(between 2 4 #\a) "aaaaa")))
172 (assert-true (peg-match? m))
173 (assert-equal 4 (peg-match-end m))))
175 (test "fail below min"
176 (assert-false (peg/match '(between 2 4 #\a) "a"))))
178;; ============================================================
179;; Captures
180;; ============================================================
182(test-group "basic capture"
183 (test "capture matched text"
184 (let ((m (peg/match '(<- (+ (char-set char-alphabetic?))) "hello world")))
185 (assert-true (peg-match? m))
186 (assert-equal '("hello") (peg-match-captures m))))
188 (test "multiple captures"
189 (let ((m (peg/match '(seq (<- (+ (char-set char-alphabetic?)))
190 " "
191 (<- (+ (char-set char-alphabetic?))))
192 "hello world")))
193 (assert-equal '("hello" "world") (peg-match-captures m)))))
195(test-group "tagged capture"
196 (test "capture with tag"
197 (let ((m (peg/match '(<- (+ (char-set char-alphabetic?)) word) "hello")))
198 (assert-equal '("hello") (peg-match-captures m)))))
200(test-group "group capture"
201 (test "group sub-captures into list"
202 (let ((m (peg/match '(group (seq (<- "a") (<- "b") (<- "c"))) "abc")))
203 (assert-equal '(("a" "b" "c")) (peg-match-captures m))))
205 (test "nested groups"
206 (let ((m (peg/match '(group (seq (<- "a") (group (seq (<- "b") (<- "c"))))) "abc")))
207 (assert-equal '(("a" ("b" "c"))) (peg-match-captures m)))))
209(test-group "position capture"
210 (test "capture current position"
211 (let ((m (peg/match '(seq "hello" (position)) "hello world")))
212 (assert-equal '(5) (peg-match-captures m)))))
214(test-group "constant capture"
215 (test "capture constant value"
216 (let ((m (peg/match '(seq "hello" (constant found-it)) "hello")))
217 (assert-equal '(found-it) (peg-match-captures m)))))
219(test-group "cmt capture"
220 (test "transform captures"
221 (let ((m (peg/match `(cmt (<- (+ (char-set char-numeric?)))
222 ,string->number)
223 "42")))
224 (assert-equal '(42) (peg-match-captures m))))
226 (test "transform multiple captures"
227 (let ((m (peg/match `(cmt (seq (<- (+ (char-set char-numeric?)))
228 "+"
229 (<- (+ (char-set char-numeric?))))
230 ,(lambda (a b) (+ (string->number a) (string->number b))))
231 "3+4")))
232 (assert-equal '(7) (peg-match-captures m)))))
234(test-group "drop capture"
235 (test "match without capturing"
236 (let ((m (peg/match '(seq (drop (+ (char-set char-whitespace?)))
237 (<- (+ (char-set char-alphabetic?))))
238 " hello")))
239 (assert-equal '("hello") (peg-match-captures m)))))
241(test-group "backref"
242 (test "match previously captured text"
243 (let ((m (peg/match '(seq (<- (+ (char-set char-alphabetic?)) word)
244 " "
245 (backref word))
246 "hello hello")))
247 (assert-true (peg-match? m))))
249 (test "fail when backref doesn't match"
250 (assert-false (peg/match '(seq (<- (+ (char-set char-alphabetic?)) word)
251 " "
252 (backref word))
253 "hello world"))))
255(test-group "replace"
256 (test "capture replacement value"
257 (let ((m (peg/match '(replace "hello" greeting) "hello")))
258 (assert-equal '(greeting) (peg-match-captures m)))))
260;; ============================================================
261;; Anchors
262;; ============================================================
264(test-group "input anchors"
265 (test "input-start at beginning"
266 (assert-true (peg-match? (peg/match '(seq (input-start) "hello") "hello"))))
268 (test "input-end at end"
269 (assert-true (peg-match? (peg/match '(seq "hello" (input-end)) "hello"))))
271 (test "input-start fails in middle"
272 (assert-false (peg/match '(seq "he" (input-start) "llo") "hello"))))
274(test-group "line anchors"
275 (test "line-start at beginning"
276 (assert-true (peg-match? (peg/match '(seq (line-start) "hello") "hello"))))
278 (test "line-start after newline"
279 (assert-true
280 (peg-match?
281 (peg/match '(seq "line1\n" (line-start) "line2") "line1\nline2"))))
283 (test "line-end before newline"
284 (assert-true
285 (peg-match?
286 (peg/match '(seq "hello" (line-end)) "hello\nworld"))))
288 (test "line-end at input end"
289 (assert-true
290 (peg-match?
291 (peg/match '(seq "hello" (line-end)) "hello")))))
293;; ============================================================
294;; Grammar Rules (define at top level to avoid closure issues)
295;; ============================================================
297(define-grammar word-pair
298 (main (seq word " " word))
299 (word (+ (char-set char-alphabetic?))))
301(define-grammar nested-parens
302 (main (seq "(" inner ")"))
303 (inner (/ main (* (seq (! "(") (! ")") any-char)))))
305(define-grammar int-parser
306 (with-bindings (to-num string->number))
307 (main (cmt (<- (+ (char-set char-numeric?))) to-num)))
309(test-group "grammars"
310 (test "define-grammar with rule references"
311 (let ((m (peg/match word-pair "hello world")))
312 (assert-true (peg-match? m))
313 (assert-equal 11 (peg-match-end m))))
315 (test "recursive grammar"
316 (assert-true (peg-match? (peg/match nested-parens "()")))
317 (assert-true (peg-match? (peg/match nested-parens "(abc)")))
318 (assert-true (peg-match? (peg/match nested-parens "(())")))
319 (assert-true (peg-match? (peg/match nested-parens "((abc))")))
320 (assert-false (peg/match nested-parens "((")))
322 (test "grammar with bindings for cmt"
323 (let ((m (peg/match int-parser "42")))
324 (assert-equal '(42) (peg-match-captures m)))))
326;; ============================================================
327;; Public API
328;; ============================================================
330(test-group "peg/find"
331 (test "find first match anywhere"
332 (let ((m (peg/find '(<- (+ (char-set char-numeric?))) "abc123def")))
333 (assert-true (peg-match? m))
334 (assert-equal 3 (peg-match-start m))
335 (assert-equal 6 (peg-match-end m))
336 (assert-equal '("123") (peg-match-captures m))))
338 (test "return #f when no match"
339 (assert-false (peg/find '(+ (char-set char-numeric?)) "abcdef"))))
341(test-group "peg/find-all"
342 (test "find all matches"
343 (let ((ms (peg/find-all '(<- (+ (char-set char-alphabetic?))) "hello world foo")))
344 (assert-equal 3 (length ms))
345 (assert-equal '("hello") (peg-match-captures (car ms)))
346 (assert-equal '("world") (peg-match-captures (cadr ms)))
347 (assert-equal '("foo") (peg-match-captures (caddr ms)))))
349 (test "empty list when no matches"
350 (assert-equal '() (peg/find-all '(+ (char-set char-numeric?)) "abcdef"))))
352(test-group "peg/replace"
353 (test "replace first match"
354 (assert-equal "abcXdef"
355 (peg/replace '(+ (char-set char-numeric?)) "X" "abc123def")))
357 (test "no match returns original"
358 (assert-equal "abcdef"
359 (peg/replace '(+ (char-set char-numeric?)) "X" "abcdef")))
361 (test "replace with procedure"
362 (assert-equal "abc456def"
363 (peg/replace '(<- (+ (char-set char-numeric?)))
364 (lambda (m)
365 (number->string (* 2 (string->number
366 (car (peg-match-captures m))))))
367 "abc228def"))))
369(test-group "peg/replace-all"
370 (test "replace all matches"
371 (assert-equal "aNbNcN"
372 (peg/replace-all '(+ (char-set char-numeric?)) "N" "a1b23c456")))
374 (test "no matches returns original"
375 (assert-equal "abc"
376 (peg/replace-all '(+ (char-set char-numeric?)) "N" "abc"))))
378(test-group "peg-match-text"
379 (test "extract matched text"
380 (let ((m (peg/find '(+ (char-set char-alphabetic?)) "123hello456")))
381 (assert-equal "hello" (peg-match-text m "123hello456")))))
383;; ============================================================
384;; Pre-built Patterns
385;; ============================================================
387(test-group "pre-built patterns"
388 (test "peg/alpha matches letter"
389 (assert-true (peg-match? (peg/match peg/alpha "a")))
390 (assert-false (peg/match peg/alpha "1")))
392 (test "peg/digit matches digit"
393 (assert-true (peg-match? (peg/match peg/digit "5")))
394 (assert-false (peg/match peg/digit "a")))
396 (test "peg/space matches whitespace"
397 (assert-true (peg-match? (peg/match peg/space " ")))
398 (assert-false (peg/match peg/space "a")))
400 (test "peg/newline matches newline"
401 (assert-true (peg-match? (peg/match peg/newline "\n")))
402 (assert-true (peg-match? (peg/match peg/newline "\r\n")))))
404;; ============================================================
405;; Practical Grammars (defined at top level)
406;; ============================================================
408(define-grammar csv-line
409 (main (seq field (* (seq "," field))))
410 (field (/ quoted-field plain-field))
411 (quoted-field (seq "\"" (<- (* (/ "\"\"" (seq (! "\"") any-char)))) "\""))
412 (plain-field (<- (* (seq (! ",") (! "\n") any-char)))))
414(define-grammar key-value
415 (main (seq ws pair (* (seq ws "," ws pair)) ws))
416 (pair (group (seq (<- ident) ws "=" ws value)))
417 (ident (+ (/ (char-set char-alphabetic?) #\_)))
418 (value (/ quoted bare))
419 (quoted (seq "\"" (<- (* (seq (! "\"") any-char))) "\""))
420 (bare (<- (+ (seq (! ",") (! (char-set char-whitespace?)) any-char))))
421 (ws (* (char-set char-whitespace?))))
423(test-group "practical: CSV field parsing"
424 (test "parse simple CSV"
425 (let ((m (peg/match csv-line "hello,world,foo")))
426 (assert-true (peg-match? m))
427 (assert-equal '("hello" "world" "foo") (peg-match-captures m))))
429 (test "parse CSV with empty fields"
430 (let ((m (peg/match csv-line "a,,c")))
431 (assert-true (peg-match? m))
432 (assert-equal '("a" "" "c") (peg-match-captures m)))))
434(test-group "practical: integer parsing"
435 (test "parse integer with sign"
436 (let ((m (peg/match `(cmt (seq (<- (? (/ "-" "+")))
437 (<- (+ (char-set char-numeric?))))
438 ,(lambda (sign digits)
439 (string->number (string-append sign digits))))
440 "-42")))
441 (assert-equal '(-42) (peg-match-captures m)))))
443(test-group "practical: key-value pairs"
444 (test "parse key-value pairs"
445 (let ((m (peg/match key-value "name=hello, age=42")))
446 (assert-true (peg-match? m))
447 (assert-equal '(("name" "hello") ("age" "42")) (peg-match-captures m)))))
449(run-tests)