From b5cef674b1f99dbb3d763cd162f1891857c40c76 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 3 Jul 2008 16:52:22 +1200 Subject: [PATCH] Pegs throw exceptions on error now --- extra/peg/parsers/parsers-tests.factor | 65 ++++++++++++-------------- extra/peg/peg-tests.factor | 60 ++++++++++++------------ extra/peg/peg.factor | 2 +- 3 files changed, 62 insertions(+), 65 deletions(-) diff --git a/extra/peg/parsers/parsers-tests.factor b/extra/peg/parsers/parsers-tests.factor index e80baf3c4f..0cf3ad8b17 100644 --- a/extra/peg/parsers/parsers-tests.factor +++ b/extra/peg/parsers/parsers-tests.factor @@ -1,54 +1,51 @@ -USING: kernel peg peg.parsers tools.test ; +USING: kernel peg peg.parsers tools.test accessors ; IN: peg.parsers.tests -[ V{ "a" } ] -[ "a" "a" token "," token list-of parse parse-result-ast ] unit-test +{ V{ "a" } } +[ "a" "a" token "," token list-of parse ast>> ] unit-test -[ V{ "a" "a" "a" "a" } ] -[ "a,a,a,a" "a" token "," token list-of parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "a,a,a,a" "a" token "," token list-of parse ast>> ] unit-test -[ f ] -[ "a" "a" token "," token list-of-many parse ] unit-test +[ "a" "a" token "," token list-of-many parse ] must-fail -[ V{ "a" "a" "a" "a" } ] -[ "a,a,a,a" "a" token "," token list-of-many parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "a,a,a,a" "a" token "," token list-of-many parse ast>> ] unit-test -[ f ] -[ "aaa" "a" token 4 exactly-n parse ] unit-test +[ "aaa" "a" token 4 exactly-n parse ] must-fail -[ V{ "a" "a" "a" "a" } ] -[ "aaaa" "a" token 4 exactly-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "aaaa" "a" token 4 exactly-n parse ast>> ] unit-test -[ f ] -[ "aaa" "a" token 4 at-least-n parse ] unit-test +[ "aaa" "a" token 4 at-least-n parse ] must-fail -[ V{ "a" "a" "a" "a" } ] -[ "aaaa" "a" token 4 at-least-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "aaaa" "a" token 4 at-least-n parse ast>> ] unit-test -[ V{ "a" "a" "a" "a" "a" } ] -[ "aaaaa" "a" token 4 at-least-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" "a" } } +[ "aaaaa" "a" token 4 at-least-n parse ast>> ] unit-test -[ V{ "a" "a" "a" "a" } ] -[ "aaaa" "a" token 4 at-most-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "aaaa" "a" token 4 at-most-n parse ast>> ] unit-test -[ V{ "a" "a" "a" "a" } ] -[ "aaaaa" "a" token 4 at-most-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "aaaaa" "a" token 4 at-most-n parse ast>> ] unit-test -[ V{ "a" "a" "a" } ] -[ "aaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" } } +[ "aaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test -[ V{ "a" "a" "a" "a" } ] -[ "aaaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "aaaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test -[ V{ "a" "a" "a" "a" } ] -[ "aaaaa" "a" token 3 4 from-m-to-n parse parse-result-ast ] unit-test +{ V{ "a" "a" "a" "a" } } +[ "aaaaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test -[ 97 ] -[ "a" any-char parse parse-result-ast ] unit-test +{ 97 } +[ "a" any-char parse ast>> ] unit-test -[ V{ } ] -[ "" epsilon parse parse-result-ast ] unit-test +{ V{ } } +[ "" epsilon parse ast>> ] unit-test { "a" } [ - "a" "a" token just parse parse-result-ast + "a" "a" token just parse ast>> ] unit-test \ No newline at end of file diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 1beeb51678..466da83b6e 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -5,9 +5,9 @@ USING: kernel tools.test strings namespaces arrays sequences peg peg.private accessors words math accessors ; IN: peg.tests -{ f } [ +[ "endbegin" "begin" token parse -] unit-test +] must-fail { "begin" "end" } [ "beginend" "begin" token parse @@ -15,13 +15,13 @@ IN: peg.tests >string ] unit-test -{ f } [ +[ "" CHAR: a CHAR: z range parse -] unit-test +] must-fail -{ f } [ +[ "1bcd" CHAR: a CHAR: z range parse -] unit-test +] must-fail { CHAR: a } [ "abcd" CHAR: a CHAR: z range parse ast>> @@ -31,9 +31,9 @@ IN: peg.tests "zbcd" CHAR: a CHAR: z range parse ast>> ] unit-test -{ f } [ +[ "bad" "a" token "b" token 2array seq parse -] unit-test +] must-fail { V{ "g" "o" } } [ "good" "g" token "o" token 2array seq parse ast>> @@ -47,13 +47,13 @@ IN: peg.tests "bbcd" "a" token "b" token 2array choice parse ast>> ] unit-test -{ f } [ +[ "cbcd" "a" token "b" token 2array choice parse -] unit-test +] must-fail -{ f } [ +[ "" "a" token "b" token 2array choice parse -] unit-test +] must-fail { 0 } [ "" "a" token repeat0 parse ast>> length @@ -67,13 +67,13 @@ IN: peg.tests "aaab" "a" token repeat0 parse ast>> ] unit-test -{ f } [ +[ "" "a" token repeat1 parse -] unit-test +] must-fail -{ f } [ +[ "b" "a" token repeat1 parse -] unit-test +] must-fail { V{ "a" "a" "a" } } [ "aaab" "a" token repeat1 parse ast>> @@ -87,17 +87,17 @@ IN: peg.tests "b" "a" token optional "b" token 2array seq parse ast>> ] unit-test -{ f } [ +[ "cb" "a" token optional "b" token 2array seq parse -] unit-test +] must-fail { V{ CHAR: a CHAR: b } } [ "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse ast>> ] unit-test -{ f } [ +[ "bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse -] unit-test +] must-fail { t } [ "a+b" @@ -117,11 +117,11 @@ IN: peg.tests parse [ t ] [ f ] if ] unit-test -{ f } [ +[ "a++b" "a" token "+" token "++" token 2array choice "b" token 3array seq parse [ t ] [ f ] if -] unit-test +] must-fail { 1 } [ "a" "a" token [ drop 1 ] action parse ast>> @@ -131,13 +131,13 @@ IN: peg.tests "aa" "a" token [ drop 1 ] action dup 2array seq parse ast>> ] unit-test -{ f } [ +[ "b" "a" token [ drop 1 ] action parse -] unit-test +] must-fail -{ f } [ +[ "b" [ CHAR: a = ] satisfy parse -] unit-test +] must-fail { CHAR: a } [ "a" [ CHAR: a = ] satisfy parse ast>> @@ -155,9 +155,9 @@ IN: peg.tests "[a]" "[" token hide "a" token "]" token hide 3array seq parse ast>> ] unit-test -{ f } [ +[ "a]" "[" token hide "a" token "]" token hide 3array seq parse -] unit-test +] must-fail { V{ "1" "-" "1" } V{ "1" "+" "1" } } [ @@ -185,9 +185,9 @@ IN: peg.tests dupd 0 swap set-nth compile word? ] unit-test -{ f } [ +[ "A" [ drop t ] satisfy [ 66 >= ] semantic parse -] unit-test +] must-fail { CHAR: B } [ "B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>> diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index a0f5fc05e8..a9695f90d8 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -280,7 +280,7 @@ SYMBOL: delayed ] with-compilation-unit ; : compiled-parse ( state word -- result ) - swap [ execute [ error-stack get throw ] unless* ] with-packrat ; inline + swap [ execute [ error-stack get first throw ] unless* ] with-packrat ; inline : parse ( input parser -- result ) dup word? [ compile ] unless compiled-parse ;