basis/peg/peg-tests.factor

   1 ! Copyright (C) 2007 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 USING: kernel tools.test strings namespaces make arrays sequences
   5        peg peg.private peg.parsers words math accessors ;
   6 IN: peg.tests
   7
   8 [ ] [ reset-pegs ] unit-test
   9
  10 [
  11   "endbegin" "begin" token parse
  12 ] must-fail
  13
  14 { "begin" "end" } [
  15   "beginend" "begin" token (parse)
  16   [ ast>> ] [ remaining>> ] bi
  17   >string
  18 ] unit-test
  19
  20 [
  21   "" CHAR: a CHAR: z range parse
  22 ] must-fail
  23
  24 [
  25   "1bcd" CHAR: a CHAR: z range parse
  26 ] must-fail
  27
  28 { CHAR: a } [
  29   "abcd" CHAR: a CHAR: z range parse
  30 ] unit-test
  31
  32 { CHAR: z } [
  33   "zbcd" CHAR: a CHAR: z range parse
  34 ] unit-test
  35
  36 [
  37   "bad" "a" token "b" token 2array seq parse
  38 ] must-fail
  39
  40 { V{ "g" "o" } } [
  41   "good" "g" token "o" token 2array seq parse
  42 ] unit-test
  43
  44 { "a" } [
  45   "abcd" "a" token "b" token 2array choice parse
  46 ] unit-test
  47
  48 { "b" } [
  49   "bbcd" "a" token "b" token 2array choice parse
  50 ] unit-test
  51
  52 [
  53   "cbcd" "a" token "b" token 2array choice parse
  54 ] must-fail
  55
  56 [
  57   "" "a" token "b" token 2array choice parse
  58 ] must-fail
  59
  60 { 0 } [
  61   "" "a" token repeat0 parse length
  62 ] unit-test
  63
  64 { 0 } [
  65   "b" "a" token repeat0 parse length
  66 ] unit-test
  67
  68 { V{ "a" "a" "a" } } [
  69   "aaab" "a" token repeat0 parse
  70 ] unit-test
  71
  72 [
  73   "" "a" token repeat1 parse
  74 ] must-fail
  75
  76 [
  77   "b" "a" token repeat1 parse
  78 ] must-fail
  79
  80 { V{ "a" "a" "a" } } [
  81   "aaab" "a" token repeat1 parse
  82 ] unit-test
  83
  84 { V{ "a" "b" } } [
  85   "ab" "a" token optional "b" token 2array seq parse
  86 ] unit-test
  87
  88 { V{ f "b" } } [
  89   "b" "a" token optional "b" token 2array seq parse
  90 ] unit-test
  91
  92 [
  93   "cb" "a" token optional "b" token 2array seq parse
  94 ] must-fail
  95
  96 { V{ CHAR: a CHAR: b } } [
  97   "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
  98 ] unit-test
  99
 100 [
 101   "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse
 102 ] must-fail
 103
 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
 109
 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
 115
 116 { t } [
 117   "a+b"
 118   "a" token "+" token "++" token 2array choice "b" token 3array seq
 119   parse [ t ] [ f ] if
 120 ] unit-test
 121
 122 [
 123   "a++b"
 124   "a" token "+" token "++" token 2array choice "b" token 3array seq
 125   parse [ t ] [ f ] if
 126 ] must-fail
 127
 128 { 1 } [
 129   "a" "a" token [ drop 1 ] action parse
 130 ] unit-test
 131
 132 { V{ 1 1 } } [
 133   "aa" "a" token [ drop 1 ] action dup 2array seq parse
 134 ] unit-test
 135
 136 [
 137   "b" "a" token [ drop 1 ] action parse
 138 ] must-fail
 139
 140 [
 141   "b" [ CHAR: a = ] satisfy parse
 142 ] must-fail
 143
 144 { CHAR: a } [
 145   "a" [ CHAR: a = ] satisfy parse
 146 ] unit-test
 147
 148 { "a" } [
 149   "    a" "a" token sp parse
 150 ] unit-test
 151
 152 { "a" } [
 153   "a" "a" token sp parse
 154 ] unit-test
 155
 156 { V{ "a" } } [
 157   "[a]" "[" token hide "a" token "]" token hide 3array seq parse
 158 ] unit-test
 159
 160 [
 161   "a]" "[" token hide "a" token "]" token hide 3array seq parse
 162 ] must-fail
 163
 164
 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
 173
 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 ;
 178
 179 { V{ V{ "1" "+" "1" } "+" "1" } } [
 180   "1+1+1" expr parse
 181 ] unit-test
 182
 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
 189
 190 [
 191   "A" [ drop t ] satisfy [ 66 >= ] semantic parse
 192 ] must-fail
 193
 194 { CHAR: B } [
 195   "B" [ drop t ] satisfy [ 66 >= ] semantic parse
 196 ] unit-test
 197
 198 { f } [ \ + T{ parser f f f } equal? ] unit-test
 199
 200 USE: compiler
 201
 202 [ ] [ disable-optimizer ] unit-test
 203
 204 [ ] [ "" epsilon parse drop ] unit-test
 205
 206 [ ] [ enable-optimizer ] unit-test
 207
 208 [ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test