basis/peg/peg-tests.factor

   1 ! Copyright (C) 2007 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 USING: continuations kernel tools.test strings namespaces make arrays
   5 sequences 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
 209
 210 {
 211     T{ parse-error
 212        { position 0 }
 213        { got "fbcd" }
 214        { messages V{ "'a'" "'b'" } }
 215     }
 216 } [
 217     [ "fbcd" "a" token "b" token 2array choice parse ] [ ] recover
 218 ] unit-test