Permalink
Browse files

36 new tests for tighter/looser/equiv. tighter+looser is not tested, …

…as semantics uncertain
  • Loading branch information...
1 parent 3332d84 commit dff3b35c11a74c9b078f6dc8aa6b144b7cae1a08 @sorear committed Jun 16, 2011
Showing with 70 additions and 3 deletions.
  1. +3 −3 TODO
  2. +67 −0 test2.pl
View
6 TODO
@@ -100,8 +100,8 @@ Other stuff to do after:
- cnperl6 prototyping...
- CLR: KISS and then play with async I/O, possibly including soric
- Fix up name handling
- - fix stubbing of qualified packages
+ + fix stubbing of qualified packages
- fix { my $x } crash
- - blast/statement_level
- - checking redeclaration of our symbols, methods, attributes...
+ + blast/statement_level
+ + checking redeclaration of our symbols, methods, attributes...
- is tighter/looser/equiv
View
67 test2.pl
@@ -31,6 +31,73 @@
class F2855::G7136 { }
], "can stub then define nested classes";
+{
+ my @l = gather for 1,2 { take $_ };
+ is ~@l, "1 2", "gather for works";
+
+ eval_dies_ok 'class { has $!foo; has $!foo; }',
+ "double attribute declaration caught";
+
+ eval_dies_ok 'class { method abar {}; method abar {}; }',
+ "double method declaration caught";
+
+ # <chain> isn't tested here. It's not possible to do the same AST
+ # reconstruction tricks. However if <right> etc work, and chained
+ # comparisons work, it's pretty likely to work combinationally.
+ sub infix:<@a> { "a(@_.Str())" }
+ sub infix:<@b> is assoc<right> { "b(@_.Str())" }
+ sub infix:<@c> is assoc<list> { "c(@_.Str())" }
+ sub infix:<@d> is assoc<list> { "d(@_.Str())" }
+ sub infix:<@e> is assoc<non> { "e(@_.Str())" }
+ sub infix:<@f> is assoc<left> { "f(@_.Str())" }
+
+ is (1 @a 2), 'a(1 2)', 'basic operator function';
+ is (1 @a 2 @a 3), 'a(a(1 2) 3)', 'operators default to left assoc';
+ is (1 @f 2 @f 3), 'f(f(1 2) 3)', 'explicit assoc<left> works too';
+ is (1 @f 2 @a 3), 'f(a(1 2) 3)', 'mixed <left> at same prec works (1)';
+ is (1 @a 2 @f 3), 'a(f(1 2) 3)', 'mixed <left> at same prec works (2)';
+ is (1 @b 2 @b 3), 'b(1 b(2 3))', 'assoc<right> overrides';
+ is (1 @c 2 @c 3), 'c(1 2 3)', 'assoc<list> takes all 3 at once';
+ eval_dies_ok q[1 @c 2 @d 3], 'mixed <list> at same prec dies';
+ eval_dies_ok q[1 @e 2 @e 3], '<non> dies with 3';
+ is (1 @e 2), 'e(1 2)', '<non> with 2 works';
+
+ sub infix:<@g> is tighter<@a> { "g(@_.Str())" }
+ sub infix:<@h> is looser<@a> { "h(@_.Str())" }
+ sub infix:<@i> is tighter(&infix:<@a>) { "i(@_.Str())" }
+ sub infix:<@j> is looser(&infix:<@a>) { "j(@_.Str())" }
+ sub infix:<@k> is tighter<@h> { "k(@_.Str())" }
+ sub infix:<@l> is looser<@g> { "l(@_.Str())" }
+ sub infix:<@m> is equiv<@a> { "m(@_.Str())" }
+ sub infix:<@n> is equiv(&infix:<@a>) { "n(@_.Str())" }
+ sub infix:<@o> is equiv<@g> { "o(@_.Str())" }
+ sub infix:<@p> is equiv<@h> { "p(@_.Str())" }
+ sub infix:<@q> is equiv<@b> { "q(@_.Str())" }
+
+ my @cmptests = (
+ 'a', 'g', 1, 0, 'tighter<> works',
+ 'h', 'a', 1, 0, 'looser<> works',
+ 'a', 'i', 1, 0, 'tighter<> works with code object',
+ 'j', 'a', 1, 0, 'looser<> works with code object',
+ 'h', 'k', 1, 0, 'tighter of a looser works',
+ 'l', 'g', 1, 0, 'looser of a tighter works',
+ 'k', 'a', 1, 0, 'tighter of a looser is still looser',
+ 'a', 'l', 1, 0, 'looser of a tighter is still tighter',
+ 'm', 'a', 0, 0, 'equiv works',
+ 'n', 'a', 0, 0, 'equiv works with code object',
+ 'o', 'g', 0, 0, 'equiv of tighter works',
+ 'p', 'h', 0, 0, 'equiv of looser works',
+ 'q', 'q', 1, 1, 'equiv also copies associativity',
+ );
+ my @frags;
+ for @cmptests -> $lt, $gt, $right_br_order, $right_br_opp, $msg {
+ my @br = "'{$lt}({$gt}(1 2) 3)'", "'{$lt}(1 {$gt}(2 3))'";
+ push @frags, "is (1 @$lt 2 @$gt 3), @br[$right_br_ord], '$msg (1)';\n";
+ push @frags, "is (1 @$gt 2 @$lt 3), @br[$right_br_opp], '$msg (2)';\n";
+ }
+ eval @frags.join;
+}
+
#is $?ORIG.substr(0,5), '# vim', '$?ORIG works';
# {

0 comments on commit dff3b35

Please sign in to comment.