foobar
" @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}]) (check-deep grammar "foobar
" @[{:tag "p" :value @["foobar"]}]) # Using a large test grammar # cf05ff610 (def- specials {'fn true 'var true 'do true 'while true 'def true 'splice true 'set true 'unquote true 'quasiquote true 'quote true 'if true}) (defn- check-number [text] (and (scan-number text) text)) (defn capture-sym [text] (def sym (symbol text)) [(if (or (root-env sym) (specials sym)) :coresym :symbol) text]) (def grammar ~{:ws (set " \v\t\r\f\n\0") :readermac (set "';~,") :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:@^_|")) :token (some :symchars) :hex (range "09" "af" "AF") :escape (* "\\" (+ (set `"'0?\abefnrtvz`) (* "x" :hex :hex) (error (constant "bad hex escape")))) :comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment)) :symbol (/ ':token ,capture-sym) :keyword (/ '(* ":" (any :symchars)) (constant :keyword)) :constant (/ '(+ "true" "false" "nil") (constant :constant)) :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"") :string (/ ':bytes (constant :string)) :buffer (/ '(* "@" :bytes) (constant :string)) :long-bytes {:delim (some "`") :open (capture :delim :n) :close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n)) ,=) :main (drop (* :open (any (if-not :close 1)) :close))} :long-string (/ ':long-bytes (constant :string)) :long-buffer (/ '(* "@" :long-bytes) (constant :string)) :number (/ (cmt ':token ,check-number) (constant :number)) :raw-value (+ :comment :constant :number :keyword :string :buffer :long-string :long-buffer :parray :barray :ptuple :btuple :struct :dict :symbol) :value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws)) :root (any :value) :root2 (any (* :value :value)) :ptuple (* '"(" :root (+ '")" (error ""))) :btuple (* '"[" :root (+ '"]" (error ""))) :struct (* '"{" :root2 (+ '"}" (error ""))) :parray (* '"@" :ptuple) :barray (* '"@" :btuple) :dict (* '"@" :struct) :main (+ :root (error ""))}) (def p (peg/compile grammar)) # Just make sure is valgrind clean. (def p (-> p make-image load-image)) (assert (peg/match p "abc") "complex peg grammar 1") (assert (peg/match p "[1 2 3 4]") "complex peg grammar 2") ### ### Compiling brainfuck to Janet. ### # 20d5d560f (def- bf-peg "Peg for compiling brainfuck into a Janet source ast." (peg/compile ~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x)))) :- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x)))) :> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x)))) :< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x)))) :. (* "." (constant (prinf "%c" (get DATA POS)))) :loop (/ (* "[" :main "]") ,(fn [& captures] ~(while (not= (get DATA POS) 0) ,;captures))) :main (any (+ :s :loop :+ :- :> :< :.))})) (defn bf "Run brainfuck." [text] (eval ~(let [DATA (array/new-filled 100 0)] (var POS 50) ,;(peg/match bf-peg text)))) (defn test-bf "Test some bf for expected output." [input output] (def b @"") (with-dyns [:out b] (bf input)) (assert (= (string output) (string b)) (string "bf input '" input "' failed, expected " (describe output) ", got " (describe (string b)) "."))) (test-bf (string "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]" ">>.>---.+++++++..+++.>>.<-.<.+++.------.--------" ".>>+.>++.") "Hello World!\n") (test-bf (string ">++++++++" "[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]" ">-----.>->+++..+++.>-.<<+[>[+>+]>>]<--------------" ".>>.+++.------.--------.>+.>+.") "Hello World!\n") (test-bf (string "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---" ".>>.>.+++.------.>-.>>--.") "Hello, World!") # Regression test # issue #300 - 714bd61d5 # Just don't segfault (assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300") # Lenprefix rule # 8b5bcaee3 (def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":") ,scan-number) 1) -1))) (assert (peg/match peg "5:abcde") "lenprefix 1") (assert (not (peg/match peg "5:abcdef")) "lenprefix 2") (assert (not (peg/match peg "5:abcd")) "lenprefix 3") # Packet capture # 8b5bcaee3 (def peg2 (peg/compile ~{# capture packet length in tag :header-len :packet-header (* (/ ':d+ ,scan-number :header-len) ":") # capture n bytes from a backref :header-len :packet-body '(lenprefix (-> :header-len) 1) # header, followed by body, and drop the :header-len capture :packet (/ (* :packet-header :packet-body) ,|$1) # any exact seqence of packets (no extra characters) :main (* (any :packet) -1)})) (assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc")) "lenprefix 4") (assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc")) "lenprefix 5") (assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6") (assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7") # Issue #412 # 677737d34 (assert (peg/match '(* "a" (> -1 "a") "b") "abc") "lookhead does not move cursor") # 6d096551f (def peg3 ~{:main (* "(" (thru ")"))}) (def peg4 (peg/compile ~(* (thru "(") '(to ")")))) (assert (peg/match peg3 "(12345)") "peg thru 1") (assert (not (peg/match peg3 " (12345)")) "peg thru 2") (assert (not (peg/match peg3 "(12345")) "peg thru 3") (assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1") (assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2") (assert (not (peg/match peg4 "123(abc")) "peg thru/to 3") # 86e12369b (def peg5 (peg/compile [3 "abc"])) (assert (:match peg5 "abcabcabc") "repeat alias 1") (assert (:match peg5 "abcabcabcac") "repeat alias 2") (assert (not (:match peg5 "abcabc")) "repeat alias 3") # Peg find and find-all # c26f57362 (def p "/usr/local/bin/janet") (assert (= (peg/find '"n/" p) 13) "peg find 1") (assert (not (peg/find '"t/" p)) "peg find 2") (assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all") # Peg replace and replace-all # e548e1f6e (defn check-replacer [x y z] (assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace") (assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all")) (check-replacer "abc" "Z" "abcabcabcabasciabsabc") (check-replacer "abc" "Z" "") (check-replacer "aba" "ZZZZZZ" "ababababababa") (check-replacer "aba" "" "ababababababa") # 485099fd6 (check-replacer "aba" string/ascii-upper "ababababababa") (check-replacer "aba" 123 "ababababababa") (assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa")) "ABcAA") "peg/replace-all cfunction") (assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa")) "abcaa") "peg/replace-all function") # 9dc7e8ed3 (defn peg-test [name f peg subst text expected] (assert (= (string (f peg subst text)) expected) name)) (peg-test "peg/replace has access to captures" peg/replace ~(sequence "." (capture (set "ab"))) (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char))) ".a.b.c" ".a -> A, .b.c") (peg-test "peg/replace-all has access to captures" peg/replace-all ~(sequence "." (capture (set "ab"))) (fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char))) ".a.b.c" ".a -> A, .b -> B, .c") # Peg bug # eab5f67c5 (assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1") (assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2") (assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3") (assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4") (assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5") (assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6") # number pattern # cccbdc164 (assert (deep= @[111] (peg/match '(number :d+) "111")) "simple number capture 1") (assert (deep= @[255] (peg/match '(number :w+) "0xff")) "simple number capture 2") # Marshal and unmarshal pegs # 446ab037b (def p (-> "abcd" peg/compile marshal unmarshal)) (assert (peg/match p "abcd") "peg marshal 1") (assert (peg/match p "abcdefg") "peg marshal 2") (assert (not (peg/match p "zabcdefg")) "peg marshal 3") # to/thru bug # issue #971 - a895219d2 (def pattern (peg/compile '{:dd (sequence :d :d) :sep (set "/-") :date (sequence :dd :sep :dd) :wsep (some (set " \t")) :entry (group (sequence (capture :date) :wsep (capture :date))) :main (some (thru :entry))})) (def alt-pattern (peg/compile '{:dd (sequence :d :d) :sep (set "/-") :date (sequence :dd :sep :dd) :wsep (some (set " \t")) :entry (group (sequence (capture :date) :wsep (capture :date))) :main (some (choice :entry 1))})) (def text "1800-10-818-9-818 16/12\n17/12 19/12\n20/12 11/01") (assert (deep= (peg/match pattern text) (peg/match alt-pattern text)) "to/thru bug #971") # 14657a7 (def- sym-prefix-peg (peg/compile ~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:@^_")) :anchor (drop (cmt ($) ,|(= $ 0))) :cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar))) :recur (+ :cap (> -1 :recur)) :main (> -1 :recur)})) (assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback") (assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2") # issue #1027 - 356b39c6f (assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1") # issue #1026 - 9341081a4 (assert (deep= (peg/match '(not (* (constant 7) "a")) "hello") @[]) "peg not") (assert (deep= (peg/match '(if-not (* (constant 7) "a") "hello") "hello") @[]) "peg if-not") (assert (deep= (peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello") @[]) "peg if-not drop") (assert (deep= (peg/match '(if (not (* (constant 7) "a")) "hello") "hello") @[]) "peg if not") (defn test [name peg input expected] (assert (deep= (peg/match peg input) expected) name)) (test "sub: matches the same input twice" ~(sub "abcd" "abc") "abcdef" @[]) (test "sub: second pattern cannot match more than the first pattern" ~(sub "abcd" "abcde") "abcdef" nil) (test "sub: fails if first pattern fails" ~(sub "x" "abc") "abcdef" nil) (test "sub: fails if second pattern fails" ~(sub "abc" "x") "abcdef" nil) (test "sub: keeps captures from both patterns" ~(sub '"abcd" '"abc") "abcdef" @["abcd" "abc"]) (test "sub: second pattern can reference captures from first" ~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag))) "abcdef" @[5 "abc" "abc"]) (test "sub: second pattern can't see past what the first pattern matches" ~(sub "abc" (* "abc" -1)) "abcdef" @[]) (test "sub: positions inside second match are still relative to the entire input" ~(* "one\ntw" (sub "o" (* ($) (line) (column)))) "one\ntwo\nthree\n" @[6 2 3]) (test "sub: advances to the end of the first pattern's match" ~(* (sub "abc" "ab") "d") "abcdef" @[]) (test "split: basic functionality" ~(split "," '1) "a,b,c" @["a" "b" "c"]) (test "split: drops captures from separator pattern" ~(split '"," '1) "a,b,c" @["a" "b" "c"]) (test "split: can match empty subpatterns" ~(split "," ':w*) ",a,,bar,,,c,," @["" "a" "" "bar" "" "" "c" "" ""]) (test "split: subpattern is limited to only text before the separator" ~(split "," '(to -1)) "a,,bar,c" @["a" "" "bar" "c"]) (test "split: fails if any subpattern fails" ~(split "," '"a") "a,a,b" nil) (test "split: separator does not have to match anything" ~(split "x" '(to -1)) "a,a,b" @["a,a,b"]) (test "split: always consumes entire input" ~(split 1 '"") "abc" @["" "" "" ""]) (test "split: separator can be an arbitrary PEG" ~(split :s+ '(to -1)) "a b c" @["a" "b" "c"]) (test "split: does not advance past the end of the input" ~(* (split "," ':w+) 0) "a,b,c" @["a" "b" "c"]) (end-suite)