Bug fixes for lcs.diff2html; xml.writer
[factor/jcg.git] / basis / peg / peg-tests.factor
blob9a15dd210575ffc9f6629fbb9e66c252c8aaee44
1 ! Copyright (C) 2007 Chris Double.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: kernel tools.test strings namespaces make arrays sequences 
5        peg peg.private peg.parsers accessors words math accessors ;
6 IN: peg.tests
8 [ ] [ reset-pegs ] unit-test
11   "endbegin" "begin" token parse
12 ] must-fail
14 { "begin" "end" } [
15   "beginend" "begin" token (parse) 
16   [ ast>> ] [ remaining>> ] bi
17   >string
18 ] unit-test
21   "" CHAR: a CHAR: z range parse
22 ] must-fail
25   "1bcd" CHAR: a CHAR: z range parse
26 ] must-fail
28 { CHAR: a } [
29   "abcd" CHAR: a CHAR: z range parse
30 ] unit-test
32 { CHAR: z } [
33   "zbcd" CHAR: a CHAR: z range parse
34 ] unit-test
37   "bad" "a" token "b" token 2array seq parse
38 ] must-fail
40 { V{ "g" "o" } } [
41   "good" "g" token "o" token 2array seq parse
42 ] unit-test
44 { "a" } [
45   "abcd" "a" token "b" token 2array choice parse
46 ] unit-test
48 { "b" } [
49   "bbcd" "a" token "b" token 2array choice parse
50 ] unit-test
53   "cbcd" "a" token "b" token 2array choice parse 
54 ] must-fail
57   "" "a" token "b" token 2array choice parse 
58 ] must-fail
60 { 0 } [
61   "" "a" token repeat0 parse length
62 ] unit-test
64 { 0 } [
65   "b" "a" token repeat0 parse length
66 ] unit-test
68 { V{ "a" "a" "a" } } [
69   "aaab" "a" token repeat0 parse 
70 ] unit-test
73   "" "a" token repeat1 parse 
74 ] must-fail
77   "b" "a" token repeat1 parse 
78 ] must-fail
80 { V{ "a" "a" "a" } } [
81   "aaab" "a" token repeat1 parse
82 ] unit-test
84 { V{ "a" "b" } } [ 
85   "ab" "a" token optional "b" token 2array seq parse 
86 ] unit-test
88 { V{ f "b" } } [ 
89   "b" "a" token optional "b" token 2array seq parse 
90 ] unit-test
92
93   "cb" "a" token optional "b" token 2array seq parse  
94 ] must-fail
96 { V{ CHAR: a CHAR: b } } [
97   "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
98 ] unit-test
101   "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse 
102 ] must-fail
104 { t } [
105   "a+b" 
106   "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
107   parse [ t ] [ f ] if
108 ] unit-test
110 { t } [
111   "a++b" 
112   "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
113   parse [ t ] [ f ] if
114 ] unit-test
116 { t } [
117   "a+b" 
118   "a" token "+" token "++" token 2array choice "b" token 3array seq
119   parse [ t ] [ f ] if
120 ] unit-test
123   "a++b" 
124   "a" token "+" token "++" token 2array choice "b" token 3array seq
125   parse [ t ] [ f ] if
126 ] must-fail
128 { 1 } [
129   "a" "a" token [ drop 1 ] action parse 
130 ] unit-test
132 { V{ 1 1 } } [
133   "aa" "a" token [ drop 1 ] action dup 2array seq parse 
134 ] unit-test
137   "b" "a" token [ drop 1 ] action parse 
138 ] must-fail
141   "b" [ CHAR: a = ] satisfy parse 
142 ] must-fail
144 { CHAR: a } [ 
145   "a" [ CHAR: a = ] satisfy parse
146 ] unit-test
148 { "a" } [
149   "    a" "a" token sp parse
150 ] unit-test
152 { "a" } [
153   "a" "a" token sp parse
154 ] unit-test
156 { V{ "a" } } [
157   "[a]" "[" token hide "a" token "]" token hide 3array seq parse
158 ] unit-test
161   "a]" "[" token hide "a" token "]" token hide 3array seq parse 
162 ] must-fail
165 { V{ "1" "-" "1" } V{ "1" "+" "1" } } [
166   [
167     [ "1" token , "-" token , "1" token , ] seq* ,
168     [ "1" token , "+" token , "1" token , ] seq* ,
169   ] choice* 
170   "1-1" over parse swap
171   "1+1" swap parse
172 ] unit-test
174 : expr ( -- parser ) 
175   #! Test direct left recursion. Currently left recursion should cause a
176   #! failure of that parser.
177   [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
179 { V{ V{ "1" "+" "1" } "+" "1" } } [
180   "1+1+1" expr parse   
181 ] unit-test
183 { t } [
184   #! Ensure a circular parser doesn't loop infinitely
185   [ f , "a" token , ] seq*
186   dup peg>> parsers>>
187   dupd 0 swap set-nth compile word?
188 ] unit-test
191   "A" [ drop t ] satisfy [ 66 >= ] semantic parse 
192 ] must-fail
194 { CHAR: B } [
195   "B" [ drop t ] satisfy [ 66 >= ] semantic parse
196 ] unit-test
198 { f } [ \ + T{ parser f f f } equal? ] unit-test
200 USE: compiler
202 [ ] [ disable-compiler ] unit-test
204 [ ] [ "" epsilon parse drop ] unit-test
206 [ ] [ enable-compiler ] unit-test
208 [ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
209   
210 [ [ ] ] [ "" epsilon [ drop [ [ ] ] ] action [ call ] action parse ] unit-test