Skip to content
Browse files

[gsoc_spectest] Added more angle bracket syntax tests. Almost done wi…

…th it. Moved charset.t and combchar.t to spec. (added 17 tests)

git-svn-id: http://svn.pugscode.org/pugs@21623 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 3ff8ad1 commit 27ad25fc295cbccfab1b43be6c675dc881da7fb1 Auzon committed
Showing with 185 additions and 20 deletions.
  1. +74 −2 S05-metasyntax/angle-brackets.t
  2. +57 −0 S05-metasyntax/charset.t
  3. +32 −0 S05-metasyntax/combchar.t
  4. +22 −18 S05-metasyntax/litvar.t
View
76 S05-metasyntax/angle-brackets.t
@@ -1,7 +1,7 @@
use v6;
use Test;
-plan 25;
+plan 42;
=begin pod
@@ -129,4 +129,76 @@ character classes), and those are referenced at the correct spot.
ok('abc.**2def' ~~ /<@second>/, 'Regexes are left alone in <@foo> subrule');
}
-# more to do yet.
+# A leading % matches like a bare hash except that
+# a string value is always treated as a subrule
+{
+ my %first = {'<alpha>' => '', 'b' => '', 'c' => ''};
+ ok('aeiou' ~~ /<%first>/, 'strings are treated as a subrule in <%foo>');
+
+ my %second = {rx/\.**2/ => '', rx/'.**2'/ => ''};
+ ok('abc.**2def' ~~ /<%second>/, 'Regexes are left alone in <%foo> subrule');
+}
+
+# A leading { indicates code that produces a regex to be
+# interpolated into the pattern at that point as a subrule:
+{
+ ok('abcdef' ~~ /<{'<al' ~ 'pha>'}>/, 'code interpolation');
+}
+
+# A leading & interpolates the return value of a subroutine call as a regex.
+{
+ my sub foo {return '<alpha>'}
+ ok('abcdef' ~~ /<&foo()>/, 'subroutine call interpolation');
+}
+
+# If it is a string, the compiled form is cached with the string so that
+# it is not recompiled next time you use it unless the string changes.
+{
+ my $counter = 0;
+ my $subrule = '{$counter++; \'<alpha>\'}';
+
+ 'abc' ~~ /<$subrule>/;
+ is($counter, 1, 'code inside string was executed');
+
+ 'def' ~~ /<$subrule>/;
+ is($counter, 1, 'string value was cached');
+}
+
+# A leading ?{ or !{ indicates a code assertion
+{
+ ok('192' ~~ /(\d**1..3) <?{$0 < 256}>/, '<?{...}> works');
+ ok(!('992' ~~ /(\d**1..3) <?{$0 < 256}>/), '<?{...}> works');
+ ok(!('192' ~~ /(\d**1..3) <!{$0 < 256}>/), '<!{...}> works');
+ ok('992' ~~ /(\d**1..3) <!{$0 < 256}>/, '<!{...}> works');
+}
+
+# A leading [ indicates an enumerated character class
+# A leading - indicates a complemented character class
+# A leading + may also be supplied
+# see charset.t
+
+# The special assertion <.>
+# see combchar.t
+
+# L<S05/Extensible metasyntax (<...>)/A leading ! indicates a negated meaning (always a zero-width assertion)>
+{
+ ok('1./:"{}=-_' ~~ /^<!alpha>+$/, '<!alpha> matches non-letter characters');
+ ok(!('abcdef' ~~ /<!alpha>/), '<!alpha> does not match letter characters');
+ is('.2 1' ~~ /(<!before .> \d)/, 1, '<!foo> does not capture');
+}
+
+# A leading ? indicates a positive zero-width assertion
+{
+ is('123abc456def' ~~ /(.+ <?alpha>)/, '123', 'positive zero-width assertion');
+}
+
+# The <...>, <???>, and <!!!> special tokens have the same "not-defined-yet"
+# meanings within regexes that the bare elipses have in ordinary code
+{
+ eval_dies_ok('"foo" ~~ /<...>/', '<...> dies in regex match');
+ # XXX: Should be warns_ok, but we don't have that yet
+ lives_ok({'foo' ~~ /<???>/}, '<???> lives in regex match');
+ eval_dies_ok('"foo" ~~ /<!!!>/', '<!!!> dies in regex match');
+}
+
+# and more to come...
View
57 S05-metasyntax/charset.t
@@ -0,0 +1,57 @@
+use v6;
+
+use Test;
+
+=begin pod
+
+This file was derived from the perl5 CPAN module Perl6::Rules,
+version 0.3 (12 Apr 2004), file t/charset.t.
+
+It has (hopefully) been, and should continue to be, updated to
+be valid perl6.
+
+=end pod
+
+plan 24;
+
+if !eval('("a" ~~ /a/)') {
+ skip_rest "skipped tests - rules support appears to be missing";
+} else {
+
+# Broken:
+# L<S05/Extensible metasyntax (C<< <...> >>)/"A leading [ ">
+
+ok("zyxaxyz" ~~ m/(<[aeiou]>)/, 'Simple set');
+is($0, 'a', 'Simple set capture');
+
+# L<S05/Extensible metasyntax (C<< <...> >>)/"A leading - indicates">
+ok(!( "a" ~~ m/<-[aeiou]>/ ), 'Simple neg set failure');
+ok("f" ~~ m/(<-[aeiou]>)/, 'Simple neg set match');
+is($0, 'f', 'Simple neg set capture');
+
+# L<S05/Extensible metasyntax (C<< <...> >>)/Character classes can be combined>
+ok(!( "a" ~~ m/(<[a..z]-[aeiou]>)/ ), 'Difference set failure');
+ok("y" ~~ m/(<[a..z]-[aeiou]>)/, 'Difference set match');
+is($0, 'y', 'Difference set capture');
+ok(!( "a" ~~ m/(<+alpha-[aeiou]>)/ ), 'Named difference set failure');
+ok("y" ~~ m/(<+alpha-[aeiou]>)/, 'Named difference set match');
+is($0, 'y', 'Named difference set capture');
+ok(!( "y" ~~ m/(<[a..z]-[aeiou]-[y]>)/ ), 'Multi-difference set failure');
+ok("f" ~~ m/(<[a..z]-[aeiou]-[y]>)/, 'Multi-difference set match');
+is($0, 'f', 'Multi-difference set capture');
+
+# XXX: Is this a valid regex? - Auzon, 2008-07-29
+#?pugs todo 'feature'
+ok(']' ~~ m/(<[]]>)/, 'LSB match');
+#?pugs todo 'bug'
+is($0, ']', 'LSB capture');
+ok(']' ~~ m/(<[\]]>)/, 'quoted close LSB match');
+is($0, ']', 'quoted close LSB capture');
+ok('[' ~~ m/(<[\[]>)/, 'quoted open LSB match');
+is($0, '[', 'quoted open LSB capture');
+ok('{' ~~ m/(<[\{]>)/, 'quoted open LCB match');
+is($0, '{', 'quoted open LCB capture');
+ok('}' ~~ m/(<[\}]>)/, 'quoted close LCB match');
+is($0, '}', 'quoted close LCB capture');
+
+}
View
32 S05-metasyntax/combchar.t
@@ -0,0 +1,32 @@
+use v6;
+
+use Test;
+
+=begin pod
+
+This file was derived from the perl5 CPAN module Perl6::Rules,
+version 0.3 (12 Apr 2004), file t/combchar.t.
+
+It has (hopefully) been, and should continue to be, updated to
+be valid perl6.
+
+=end pod
+
+plan 3;
+
+if !eval('("a" ~~ /a/)') {
+ skip_rest "skipped tests - rules support appears to be missing";
+} else {
+
+# L<S05/Extensible metasyntax (C<< <...> >>)/matches any logical grapheme>
+
+my $unichar = "\c[GREEK CAPITAL LETTER ALPHA]";
+my $combchar = "\c[LATIN CAPITAL LETTER A]\c[COMBINING ACUTE ACCENT]";
+
+#?pugs todo 'feature'
+ok("A" ~~ m/^<.>$/, 'ASCII');
+ok($combchar ~~ m/^<.>$/, 'Unicode combining');
+ok($unichar ~~ m/^<.>$/, 'Unicode');
+
+}
+
View
40 S05-metasyntax/litvar.t
@@ -25,17 +25,19 @@ my $href = \%var;
# SCALARS
-ok($var ~~ m/$var/, 'Simple scalar interpolation', :todo<bug>);
-ok("zzzzzz{$var}zzzzzz" ~~ m/$var/, 'Nested scalar interpolation', :todo<bug>);
+#?pugs 2 todo 'bug'
+ok($var ~~ m/$var/, 'Simple scalar interpolation');
+ok("zzzzzz{$var}zzzzzz" ~~ m/$var/, 'Nested scalar interpolation');
ok(!( "aaaaab" ~~ m/$var/ ), 'Rulish scalar interpolation');
-ok('a' ~~ m/$aref[0]/, 'Array ref 0', :todo<feature>);
-ok('a' ~~ m/$aref.[0]/, 'Array ref dot 0', :todo<feature>);
-ok('a' ~~ m/@var[0]/, 'Array 0', :todo<feature>);
+#?pugs 6 todo 'feature'
+ok('a' ~~ m/$aref[0]/, 'Array ref 0');
+ok('a' ~~ m/$aref.[0]/, 'Array ref dot 0');
+ok('a' ~~ m/@var[0]/, 'Array 0');
-ok('1' ~~ m/$href.{a}/, 'Hash ref dot A', :todo<feature>);
-ok('1' ~~ m/$href{a}/, 'Hash ref A', :todo<feature>);
-ok('1' ~~ m/%var{a}/, 'Hash A', :todo<feature>);
+ok('1' ~~ m/$href.{a}/, 'Hash ref dot A');
+ok('1' ~~ m/$href{a}/, 'Hash ref A');
+ok('1' ~~ m/%var{a}/, 'Hash A');
ok(!( 'a' ~~ m/$aref[1]/ ), 'Array ref 1');
ok(!( 'a' ~~ m/$aref.[1]/ ), 'Array ref dot 1');
@@ -55,24 +57,26 @@ ok('quxbaz' !~~ /$rx baz/, 'nonmatching regex object in a regex');
# ARRAYS
# L<S05/Variable (non-)interpolation/An interpolated array:>
-ok("a" ~~ m/@var/, 'Simple array interpolation (a)', :todo<feature>);
-ok("b" ~~ m/@var/, 'Simple array interpolation (b)', :todo<feature>);
-ok("c" ~~ m/@var/, 'Simple array interpolation (c)', :todo<feature>);
+#?pugs 3 todo 'feature'
+ok("a" ~~ m/@var/, 'Simple array interpolation (a)');
+ok("b" ~~ m/@var/, 'Simple array interpolation (b)');
+ok("c" ~~ m/@var/, 'Simple array interpolation (c)');
ok(!( "d" ~~ m/@var/ ), 'Simple array interpolation (d)');
-ok("ddddaddddd" ~~ m/@var/, 'Nested array interpolation (a)', :todo<feature>);
+#?pugs 2 todo 'feature'
+ok("ddddaddddd" ~~ m/@var/, 'Nested array interpolation (a)');
-ok("abca" ~~ m/^@var+$/, 'Multiple array matching', :todo<feature>);
+ok("abca" ~~ m/^@var+$/, 'Multiple array matching');
ok(!( "abcad" ~~ m/^@var+$/ ), 'Multiple array non-matching');
# HASHES
# L<S05/Variable (non-)interpolation/An interpolated hash provides>
-ok("a" ~~ m/%var/, 'Simple hash interpolation (a)', :todo<feature>);
-ok("b" ~~ m/%var/, 'Simple hash interpolation (b)', :todo<feature>);
-ok("c" ~~ m/%var/, 'Simple hash interpolation (c)', :todo<feature>);
+ok("a" ~~ m/%var/, 'Simple hash interpolation (a)');
+ok("b" ~~ m/%var/, 'Simple hash interpolation (b)');
+ok("c" ~~ m/%var/, 'Simple hash interpolation (c)');
ok(!( "d" ~~ m/%var/ ), 'Simple hash interpolation (d)');
-ok("====a=====" ~~ m/%var/, 'Nested hash interpolation (a)', :todo<feature>);
+ok("====a=====" ~~ m/%var/, 'Nested hash interpolation (a)');
ok(!( "abca" ~~ m/^%var$/ ), 'Simple hash non-matching');
-ok("a b c a" ~~ m:s/^[ %var]+$/, 'Simple hash repeated matching', :todo<feature>);
+ok("a b c a" ~~ m:s/^[ %var]+$/, 'Simple hash repeated matching');

0 comments on commit 27ad25f

Please sign in to comment.
Something went wrong with that request. Please try again.