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 accessors words math accessors ;
   6 IN: peg.tests
   7
   8 \ parse must-infer
   9
  10 [ ] [ reset-pegs ] unit-test
  11
  12 [
  13   "endbegin" "begin" token parse
  14 ] must-fail
  15
  16 { "begin" "end" } [
  17   "beginend" "begin" token (parse)
  18   [ ast>> ] [ remaining>> ] bi
  19   >string
  20 ] unit-test
  21
  22 [
  23   "" CHAR: a CHAR: z range parse
  24 ] must-fail
  25
  26 [
  27   "1bcd" CHAR: a CHAR: z range parse
  28 ] must-fail
  29
  30 { CHAR: a } [
  31   "abcd" CHAR: a CHAR: z range parse
  32 ] unit-test
  33
  34 { CHAR: z } [
  35   "zbcd" CHAR: a CHAR: z range parse
  36 ] unit-test
  37
  38 [
  39   "bad" "a" token "b" token 2array seq parse
  40 ] must-fail
  41
  42 { V{ "g" "o" } } [
  43   "good" "g" token "o" token 2array seq parse
  44 ] unit-test
  45
  46 { "a" } [
  47   "abcd" "a" token "b" token 2array choice parse
  48 ] unit-test
  49
  50 { "b" } [
  51   "bbcd" "a" token "b" token 2array choice parse
  52 ] unit-test
  53
  54 [
  55   "cbcd" "a" token "b" token 2array choice parse
  56 ] must-fail
  57
  58 [
  59   "" "a" token "b" token 2array choice parse
  60 ] must-fail
  61
  62 { 0 } [
  63   "" "a" token repeat0 parse length
  64 ] unit-test
  65
  66 { 0 } [
  67   "b" "a" token repeat0 parse length
  68 ] unit-test
  69
  70 { V{ "a" "a" "a" } } [
  71   "aaab" "a" token repeat0 parse
  72 ] unit-test
  73
  74 [
  75   "" "a" token repeat1 parse
  76 ] must-fail
  77
  78 [
  79   "b" "a" token repeat1 parse
  80 ] must-fail
  81
  82 { V{ "a" "a" "a" } } [
  83   "aaab" "a" token repeat1 parse
  84 ] unit-test
  85
  86 { V{ "a" "b" } } [
  87   "ab" "a" token optional "b" token 2array seq parse
  88 ] unit-test
  89
  90 { V{ f "b" } } [
  91   "b" "a" token optional "b" token 2array seq parse
  92 ] unit-test
  93
  94 [
  95   "cb" "a" token optional "b" token 2array seq parse
  96 ] must-fail
  97
  98 { V{ CHAR: a CHAR: b } } [
  99   "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
 100 ] unit-test
 101
 102 [
 103   "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse
 104 ] must-fail
 105
 106 { t } [
 107   "a+b"
 108   "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
 109   parse [ t ] [ f ] if
 110 ] unit-test
 111
 112 { t } [
 113   "a++b"
 114   "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
 115   parse [ t ] [ f ] if
 116 ] unit-test
 117
 118 { t } [
 119   "a+b"
 120   "a" token "+" token "++" token 2array choice "b" token 3array seq
 121   parse [ t ] [ f ] if
 122 ] unit-test
 123
 124 [
 125   "a++b"
 126   "a" token "+" token "++" token 2array choice "b" token 3array seq
 127   parse [ t ] [ f ] if
 128 ] must-fail
 129
 130 { 1 } [
 131   "a" "a" token [ drop 1 ] action parse
 132 ] unit-test
 133
 134 { V{ 1 1 } } [
 135   "aa" "a" token [ drop 1 ] action dup 2array seq parse
 136 ] unit-test
 137
 138 [
 139   "b" "a" token [ drop 1 ] action parse
 140 ] must-fail
 141
 142 [
 143   "b" [ CHAR: a = ] satisfy parse
 144 ] must-fail
 145
 146 { CHAR: a } [
 147   "a" [ CHAR: a = ] satisfy parse
 148 ] unit-test
 149
 150 { "a" } [
 151   "    a" "a" token sp parse
 152 ] unit-test
 153
 154 { "a" } [
 155   "a" "a" token sp parse
 156 ] unit-test
 157
 158 { V{ "a" } } [
 159   "[a]" "[" token hide "a" token "]" token hide 3array seq parse
 160 ] unit-test
 161
 162 [
 163   "a]" "[" token hide "a" token "]" token hide 3array seq parse
 164 ] must-fail
 165
 166
 167 { V{ "1" "-" "1" } V{ "1" "+" "1" } } [
 168   [
 169     [ "1" token , "-" token , "1" token , ] seq* ,
 170     [ "1" token , "+" token , "1" token , ] seq* ,
 171   ] choice*
 172   "1-1" over parse swap
 173   "1+1" swap parse
 174 ] unit-test
 175
 176 : expr ( -- parser )
 177   #! Test direct left recursion. Currently left recursion should cause a
 178   #! failure of that parser.
 179   [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
 180
 181 { V{ V{ "1" "+" "1" } "+" "1" } } [
 182   "1+1+1" expr parse
 183 ] unit-test
 184
 185 { t } [
 186   #! Ensure a circular parser doesn't loop infinitely
 187   [ f , "a" token , ] seq*
 188   dup peg>> parsers>>
 189   dupd 0 swap set-nth compile word?
 190 ] unit-test
 191
 192 [
 193   "A" [ drop t ] satisfy [ 66 >= ] semantic parse
 194 ] must-fail
 195
 196 { CHAR: B } [
 197   "B" [ drop t ] satisfy [ 66 >= ] semantic parse
 198 ] unit-test
 199
 200 { f } [ \ + T{ parser f f f } equal? ] unit-test
 201
 202 USE: compiler
 203
 204 [ ] [ disable-compiler ] unit-test
 205
 206 [ ] [ "" epsilon parse drop ] unit-test
 207
 208 [ ] [ enable-compiler ] unit-test
 209
 210 [ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
 211
 212 [ [ ] ] [ "" epsilon [ drop [ [ ] ] ] action [ call ] action parse ] unit-test