Author: particle
Date: Thu Nov 3 07:23:13 2005
New Revision: 9744
Modified:
trunk/compilers/pge/PGE/P6Rule.pir
trunk/t/p6rules/anchors.t
trunk/t/p6rules/backtrack.t
trunk/t/p6rules/builtins.t
trunk/t/p6rules/modifiers.t
Log:
* added pge support for <+...> metasyntax
* added pge tests for :perl5 modifier, <commit> pattern, <+...> metasyntax,
<null> pattern
* modified some test files to use strict and warnings
Modified: trunk/compilers/pge/PGE/P6Rule.pir
==============================================================================
--- trunk/compilers/pge/PGE/P6Rule.pir (original)
+++ trunk/compilers/pge/PGE/P6Rule.pir Thu Nov 3 07:23:13 2005
@@ -46,6 +46,7 @@
$P0 = find_global "PGE::P6Rule", "parse_enumclass"
optable.addtok("term:<[", "term:", "nows", $P0)
optable.addtok("term:<-[", "term:", "nows", $P0)
+ optable.addtok("term:<+[", "term:", "nows", $P0)
$P0 = find_global "PGE::P6Rule", "parse_closure"
optable.addtok("term:{{", "term:", "nows", $P0)
Modified: trunk/t/p6rules/anchors.t
==============================================================================
--- trunk/t/p6rules/anchors.t (original)
+++ trunk/t/p6rules/anchors.t Thu Nov 3 07:23:13 2005
@@ -1,7 +1,12 @@
-use Parrot::Test tests => 26;
+# $Id$
+
+use strict;
+use warnings;
+use Parrot::Test;
use Parrot::Test::PGE;
-$str = q{abc
+
+my $str = q{abc
def
-==
ghi};
@@ -38,5 +43,5 @@ p6rule_is ($str, 'a\B', '\w\w nonword
p6rule_is ($str, '-\B', '\W\W nonword boundary');
-
-# dont forget to change the number of tests :-)
+# remember to change the number of tests :-)
+BEGIN { plan tests => 26; }
Modified: trunk/t/p6rules/backtrack.t
==============================================================================
--- trunk/t/p6rules/backtrack.t (original)
+++ trunk/t/p6rules/backtrack.t Thu Nov 3 07:23:13 2005
@@ -1,18 +1,32 @@
-use Parrot::Test tests => 15;
+# $Id$
+
+use strict;
+use warnings;
+use Parrot::Test;
use Parrot::Test::PGE;
+
+## tests based on http://dev.perl.org/perl6/doc/design/syn/S05.html, ver. 7
+## in the 'Backtracking control' section
+
+
+## : -- cut over preceding atom
p6rule_is ('bazaar', 'a* a', 'control');
p6rule_isnt('bazaar', 'a*:a', 'basic');
p6rule_is ('abbabbababba', '^[a|b]* aba', 'control');
p6rule_isnt('abbabbababba', '^[a|b]*: aba', 'outside a group');
+
+## :: -- cut over surrounding group of alternations
p6rule_is ('verify', '[ if not | ify ]', 'control');
p6rule_isnt('verify', '[ if :: not | ify ]', 'inside a group');
p6rule_isnt('verify', ' if :: not | ify', 'the default all group');
p6rule_is ('verify', '[ if : not | ify ]', 'simple backtrack still works');
p6rule_is ('verify', '[ if :: not | ify ] | verify', 'rule continues');
+
+## ::: -- cut over entire rule
p6rule_is ('whence', '[ when ever ] | whence', 'full backtrack failure');
p6rule_isnt('whence', '[ when ::: ever ] | whence', 'full backtrack failure');
@@ -21,4 +35,10 @@ p6rule_isnt('xyabghij', 'ab:::cd | gh:::
p6rule_is ('xyabghij', '[ab::cd | gh::ij]', 'group cut in group');
p6rule_isnt('xyabghij', '[ab:::cd | gh:::ij]', 'rule cut in group');
-# dont forget to change the number of tests :-)
+
+## <commit> -- cut over entire rule
+p6rule_isnt('whence', '[ when <commit> ever ] | whence', 'full backtrack
failure', todo => 'not yet implemented');
+
+
+# remember to change the number of tests :-)
+BEGIN { plan tests => 16; }
Modified: trunk/t/p6rules/builtins.t
==============================================================================
--- trunk/t/p6rules/builtins.t (original)
+++ trunk/t/p6rules/builtins.t Thu Nov 3 07:23:13 2005
@@ -1,10 +1,18 @@
-use Parrot::Test tests => 45;
+# $Id$
+
+use strict;
+use warnings;
+use Parrot::Test;
use Parrot::Test::PGE;
-$str =
+
+## tests based on http://dev.perl.org/perl6/doc/design/syn/S05.html, ver. 7
+## in the 'Extensible metasyntax (<...>)' and 'Nothing is illegal' sections
+
+
+my $str =
"\t\n\r !\"#\$%&'()*+,-./:;<=>[EMAIL
PROTECTED]|}0123456789ABCDEFGHIJabcdefghij";
-p6rule_is ($str, 'abc <null> def', '<null>');
p6rule_isnt($str, 'abc <fail> def', '<fail>');
p6rule_like($str, '<upper>',
@@ -113,3 +121,31 @@ p6rule_like ("aabaaa", '<!before ..b> a
'negated lookahead');
+## leading + -- enumerated char class
+p6rule_is ('az', '<[a..z]>+', 'metasyntax with leading + (<+...>)');
+p6rule_is ('az', '<+[a..z]>+', 'metasyntax with leading + (<+...>)');
+p6rule_is ('az', '<+<alpha>>+', 'metasyntax with leading + (<+...>)',
+ todo => 'not yet implemented');
+
+
+## null pattern is illegal
+p6rule_like($str, '', '/Missing term at offset.*/',
+ 'null pattern ()');
+
+
+## <null> -- null pattern
+p6rule_is ('', '<null>', 'null pattern (<null>)');
+p6rule_like($str, '^ <null>',
+ qr/mob<null>: < @ 0>/, 'null pattern (<null>)');
+p6rule_like($str, '<null> $',
+ qr/mob<null>: < @ 65>/, 'null pattern (<null>)');
+p6rule_is ($str, 'abc <null> def', 'null pattern (<null>)');
+p6rule_like($str, "abc <null> def",
+ qr/mob<null>: < @ 58>/, 'null pattern (<null>)');
+p6rule_is ($str, 'x | y | <null>', 'null pattern (<null>)',
+ todo => 'specification unclear');
+p6rule_is ($str, 'x | y | <?null>', 'null pattern (<null>)');
+
+
+## remember to change the number of tests :-)
+BEGIN { plan tests => 55; }
Modified: trunk/t/p6rules/modifiers.t
==============================================================================
--- trunk/t/p6rules/modifiers.t (original)
+++ trunk/t/p6rules/modifiers.t Thu Nov 3 07:23:13 2005
@@ -10,7 +10,40 @@ use Parrot::Test::PGE;
## in the 'Modifiers' section
-## :i
+## setup template for pir tests
+my $pre = <<PRE;
+.sub 'main' :main
+ load_bytecode "PGE.pbc"
+ load_bytecode "dumper.imc"
+ load_bytecode "PGE/Dumper.pir"
+ load_bytecode "PGE/Glob.pir"
+ load_bytecode "PGE/Text.pir"
+ load_bytecode "PGE/Util.pir"
+ .local string target
+ .local string pattern
+ .local string modifier
+ .local pmc p6rule_compile
+ .local pmc rulesub
+ .local pmc pir
+ .local pmc exp
+ .local pmc match
+ find_global p6rule_compile, 'PGE', 'p6rule'
+ null match
+ null rulesub
+PRE
+my $post = <<'POST';
+ goto OK
+NOK:
+ print "not "
+OK:
+ print "ok"
+END:
+ print "\n"
+.end
+POST
+
+
+## :i and :ignorecase -- ignore case
## TODO lexical scoping of :i
p6rule_is ('abcdef', ':i bcd', 'ignorecase (:i)');
p6rule_is ('aBcdef', ':i bcd', 'ignorecase (:i)');
@@ -22,7 +55,7 @@ p6rule_is ('aBCDef', ':ignorecase bcd',
p6rule_isnt('abc-ef', ':ignorecase bcd', 'ignorecase (:ignorecase)');
-## :w
+## :w and :words -- magically ignore whitespace
## TODO lexical scoping of :w
p6rule_is ('a bcdef', ':w bcd', 'words (:w)');
p6rule_is ('a bcd ef', ':w bcd', 'words (:w)');
@@ -42,13 +75,32 @@ p6rule_is ('a b c def', ':words b c d',
p6rule_isnt('ab c d ef', ':words b c d', 'words (:words)');
-## :once
+## :once -- match only once
+pir_output_is($pre . <<'CODE' . $post, <<"OUT", 'match only once (:once)',
todo => 'syntax not specified');
+ target = "abc"
+ pattern = "abc"
+ modifier = ":once"
+# (rulesub, pir, exp) = p6rule_compile(pattern)
+# match = rulesub(target)
+# unless match goto NOK
+ goto NOK
+CODE
+ok
+OUT
+
+
+## TODO :c, :p, :g, :bytes, :codes, :graphs, :langs
+
+
+## :perl5 -- use perl5 regexp syntax
+p6rule_is ('a bcd$ef', ':perl5 \A.*? bcd\Q$\E..\z', 'perl5 syntax (:perl5)',
todo => 'not yet implemented');
+## TODO lexical scoping of :perl5
+## TODO add more tests
-## TODO :c, :p, :g, :bytes, :codes, :graphs, :langs, :perl5,
-## integer modifiers, Nth occurance, :ov, :ex, :rw, :keepall
+## TODO integer modifiers, Nth occurance, :ov, :ex, :rw, :keepall
## user-defined modifiers
## remember to change the number of tests :-)
-BEGIN { plan tests => 24; }
+BEGIN { plan tests => 26; }
