factor/basis/peg/peg-tests.factor

! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
USING: continuations kernel tools.test strings namespaces make arrays
sequences peg peg.private peg.parsers words math accessors ;
IN: peg.tests

{ } [ reset-pegs ] unit-test

[
    "endbegin" "begin" token parse
] must-fail

{ "begin" "end" } [
    "beginend" "begin" token (parse)
    [ ast>> ] [ remaining>> ] bi
    >string
] unit-test

[
    "" CHAR: a CHAR: z range parse
] must-fail

[
    "1bcd" CHAR: a CHAR: z range parse
] must-fail

{ CHAR: a } [
    "abcd" CHAR: a CHAR: z range parse
] unit-test

{ CHAR: z } [
    "zbcd" CHAR: a CHAR: z range parse
] unit-test

[
    "bad" "a" token "b" token 2array seq parse
] must-fail

{ V{ "g" "o" } } [
    "good" "g" token "o" token 2array seq parse
] unit-test

{ "a" } [
    "abcd" "a" token "b" token 2array choice parse
] unit-test

{ "b" } [
    "bbcd" "a" token "b" token 2array choice parse
] unit-test

[
    "cbcd" "a" token "b" token 2array choice parse
] must-fail

[
    "" "a" token "b" token 2array choice parse
] must-fail

{ 0 } [
    "" "a" token repeat0 parse length
] unit-test

{ 0 } [
    "b" "a" token repeat0 parse length
] unit-test

{ V{ "a" "a" "a" } } [
    "aaab" "a" token repeat0 parse
] unit-test

[
    "" "a" token repeat1 parse
] must-fail

[
    "b" "a" token repeat1 parse
] must-fail

{ V{ "a" "a" "a" } } [
    "aaab" "a" token repeat1 parse
] unit-test

{ V{ "a" "b" } } [
    "ab" "a" token optional "b" token 2array seq parse
] unit-test

{ V{ f "b" } } [
    "b" "a" token optional "b" token 2array seq parse
] unit-test

[
    "cb" "a" token optional "b" token 2array seq parse
] must-fail

{ V{ CHAR: a CHAR: b } } [
    "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse
] unit-test

[
    "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse
] must-fail

{ t } [
    "a+b"
    "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
    parse [ t ] [ f ] if
] unit-test

{ t } [
    "a++b"
    "a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
    parse [ t ] [ f ] if
] unit-test

{ t } [
    "a+b"
    "a" token "+" token "++" token 2array choice "b" token 3array seq
    parse [ t ] [ f ] if
] unit-test

[
    "a++b"
    "a" token "+" token "++" token 2array choice "b" token 3array seq
    parse [ t ] [ f ] if
] must-fail

{ 1 } [
    "a" "a" token [ drop 1 ] action parse
] unit-test

{ V{ 1 1 } } [
    "aa" "a" token [ drop 1 ] action dup 2array seq parse
] unit-test

[
    "b" "a" token [ drop 1 ] action parse
] must-fail

[
    "b" [ CHAR: a = ] satisfy parse
] must-fail

{ CHAR: a } [
    "a" [ CHAR: a = ] satisfy parse
] unit-test

{ "a" } [
    "    a" "a" token sp parse
] unit-test

{ "a" } [
    "a" "a" token sp parse
] unit-test

{ V{ "a" } } [
    "[a]" "[" token hide "a" token "]" token hide 3array seq parse
] unit-test

[
    "a]" "[" token hide "a" token "]" token hide 3array seq parse
] must-fail


{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
    [
        [ "1" token , "-" token , "1" token , ] seq* ,
        [ "1" token , "+" token , "1" token , ] seq* ,
    ] choice*
    "1-1" over parse swap
    "1+1" swap parse
] unit-test

: expr ( -- parser )
    ! Test direct left recursion. Currently left recursion should cause a
    ! failure of that parser.
    [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;

{ V{ V{ "1" "+" "1" } "+" "1" } } [
    "1+1+1" expr parse
] unit-test

{ t } [
    ! Ensure a circular parser doesn't loop infinitely
    [ f , "a" token , ] seq*
    dup peg>> parsers>>
    dupd 0 swap set-nth compile word?
] unit-test

[
    "A" [ drop t ] satisfy [ 66 >= ] semantic parse
] must-fail

{ CHAR: B } [
    "B" [ drop t ] satisfy [ 66 >= ] semantic parse
] unit-test

{ f } [ \ + T{ parser f f f } equal? ] unit-test

USE: compiler

{ } [ disable-optimizer ] unit-test

{ } [ "" epsilon parse drop ] unit-test

{ } [ enable-optimizer ] unit-test

{ [ ] } [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test

{
    T{ parse-error
       { position 0 }
       { got "fbcd" }
       { messages V{ "'a'" "'b'" } }
    }
} [
    [ "fbcd" "a" token "b" token 2array choice parse ] [ ] recover
] unit-test