Pegs throw exceptions on error now

diff --git a/extra/peg/parsers/parsers-tests.factor b/extra/peg/parsers/parsers-tests.factor
index e80baf3c4f31f6fc8f332cca1cb69774351924e3..0cf3ad8b17f4d599faa8398032fbd1c83a6be8f8 100644 (file)
--- 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 1beeb51678e174aa79f4bc871a9694c9c1b04916..466da83b6e318108bead428a0f698a5722e9609d 100644 (file)
--- 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 a0f5fc05e8e27d0a65ae3f44e6c103c4570a8dfa..a9695f90d8b6f22d5b684b005a06ec1749ad7077 100755 (executable)
--- 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 ;