Permalink
Browse files

[t/spec] split S03-operators/smartmatch.t into S03-smartmatch/*.t

git-svn-id: http://svn.pugscode.org/pugs@29536 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 4751018 commit e67eb0c6ab8582e87d61884975e78283d170cbf9 kyle committed Jan 15, 2010
View

Large diffs are not rendered by default.

Oops, something went wrong.
View
@@ -0,0 +1,19 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any Any scalars are identical>
+#?rakudo skip 'Any ~~ Any'
+{
+ class Smartmatch::ObjTest {}
+ my $a = Smartmatch::ObjTest.new;
+ my $b = Smartmatch::ObjTest.new;
+ ok ($a ~~ $a), 'Any ~~ Any (+)';
+ ok !($a !~~ $a), 'Any !~~ Any (-)';
+ ok !($a ~~ $b), 'Any ~~ Any (-)';
+ ok ($a !~~ $b), 'Any !~~ Any (+)';
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,21 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/array value slice truth>
+{
+ ok ((Mu, 1, Mu) ~~ .[1]),
+ "element 1 of (Mu, 1, Mu) is true";
+ ok !((Mu, Mu) ~~ .[0]),
+ "element 0 of (Mu, Mu) is false";
+ ok ((0, 1, 2, 3) ~~ .[1, 2, 3]),
+ "array slice .[1,2,3] of (0,1,2,3) is true";
+ ok !((0, 1, 2, 3) ~~ .[0]),
+ "array slice .[0] of (0,1,2,3) is false";
+ ok !((0, 1, 2, 3) ~~ .[0,1]),
+ "array slice .[0,1] of (0,1,2,3) is false";
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,25 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any Array lists are comparable>
+{
+ class TestArraySmartmatch {
+ has @!obj;
+ multi method list() { @!obj };
+ }
+
+ my $o = TestArraySmartmatch.new(obj => (1, 2, 4));
+
+ ok ($o ~~ [1, 2, 4]), 'Any ~~ Array (basic, +)';
+ ok !($o ~~ [1, 5, 4]), 'Any ~~ Array (basic, -)';
+ ok ($o ~~ [1, *]), 'Any ~~ Array (dwim, +)';
+ ok !($o ~~ [8, *]), 'Any ~~ Array (dwim, -)';
+ ok (1 ~~ [1]), 'Any ~~ Array (Int, +)';
+ #?rakudo todo 'Int ~~ Array'
+ ok (1 ~~ [1, 2]), 'Any ~~ Array (Int, -, it is not any())';
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,19 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any Bool simple truth>
+{
+ ok (0 ~~ True), '$something ~~ True (1)';
+ ok (0 ~~ Bool::True), '$something ~~ Bool::True (1)';
+ ok ('a' ~~ True), '$something ~~ True (2)';
+ ok ('a' ~~ Bool::True), '$something ~~ Bool::True (2)';
+ ok !(0 ~~ False), '$something ~~ False (1)';
+ ok !(0 ~~ Bool::False), '$something ~~ Bool::False (1)';
+ ok !('a' ~~ False), '$something ~~ False (2)';
+ ok !('a' ~~ Bool::False),'$something ~~ Bool::False (2)';
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,26 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/"Smart matching"/Any Callable:($) item sub truth>
+{
+ sub is_even($x) { $x % 2 == 0 }
+ sub is_odd ($x) { $x % 2 == 1 }
+ ok 4 ~~ &is_even, 'scalar sub truth (unary)';
+ ok 4 !~~ &is_odd, 'scalar sub truth (unary, negated smart-match)';
+ ok !(3 ~~ &is_even), 'scalar sub truth (unary)';
+ ok !(3 !~~ &is_odd), 'scalar sub truth (unary, negated smart-match)';
+}
+
+#L<S03/"Smart matching"/Any Callable:() simple closure truth>
+{
+ sub uhuh { 1 }
+ sub nuhuh { Mu }
+
+ ok((Mu ~~ &uhuh), "scalar sub truth");
+ ok(!(Mu ~~ &nuhuh), "negated scalar sub false");
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,22 @@
+use v6;
+use Test;
+plan *;
+
+{
+ ok (1 + 2i) ~~ (1 + 2i), 'Complex ~~ Complex (+)';
+ ok !((1 + 2i) ~~ (1 + 1i)), 'Complex ~~ Complex (-)';
+ ok !((1 + 2i) ~~ (2 + 2i)), 'Complex ~~ Complex (-)';
+ ok !((1 + 2i) !~~ (1 + 2i)), 'Complex !~~ Complex (-)';
+ ok (1 + 2i) !~~ (1 + 1i), 'Complex !~~ Complex (+)';
+ ok (1 + 2i) !~~ (2 + 2i), 'Complex !~~ Complex (+)';
+ ok 3 ~~ (3 + 0i), 'Num ~~ Complex (+)';
+ ok !(2 ~~ (3 + 0i)), 'Num ~~ Complex (-)';
+ ok !(3 ~~ (3 + 1i)), 'Num ~~ Complex (-)';
+ ok !(3 !~~ (3 + 0i)), 'Num !~~ Complex (-)';
+ ok (2 !~~ (3 + 0i)), 'Num !~~ Complex (+)';
+ ok (3 !~~ (3 + 1i)), 'Num !~~ Complex (+)';
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,19 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Hash Pair test hash mapping>
+{
+ my %a = (a => 1, b => 'foo', c => Mu);
+ ok (%a ~~ b => 'foo'), '%hash ~~ Pair (Str, +)';
+ ok !(%a ~~ b => 'ugh'), '%hash ~~ Pair (Str, -)';
+ ok (%a ~~ a => 1.0), '%hash ~~ Pair (Num, +)';
+ ok (%a ~~ :b<foo>), '%hash ~~ Colonpair';
+ ok (%a ~~ c => *.notdef), '%hash ~~ Pair (.notdef, Mu)';
+ ok (%a ~~ d => *.notdef), '%hash ~~ Pair (.notdef, Nil)';
+ ok !(%a ~~ a => 'foo'), '%hash ~~ Pair (key and val not paired)';
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,27 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/hash value slice truth>
+
+{
+ my %h = (a => 0, b => 0, c => 1, d => 2);
+ sub notautoquoted_a { 'a' };
+ sub notautoquoted_c { 'c' };
+
+ ok (%h ~~ .{'c'}), '%hash ~~ .{true"}';
+ ok !(%h ~~ .{'b'}), '%hash ~~ .{false"}';
+ ok (%h ~~ .{<c d>}), '%hash ~~ .{<true values>}';
+ ok !(%h ~~ .{<c d a>}), '%hash ~~ .{<not all true>}';
+ ok !(%h ~~ .{notautoquoted_a}), '~~. {notautoquoted_a}';
+ ok (%h ~~ .{notautoquoted_c}), '~~. {notautoquoted_c}';
+ ok (%h ~~ .<c>), '%hash ~~ .<true"}';
+ ok !(%h ~~ .<b>), '%hash ~~ .<false"}';
+ ok (%h ~~ .<c d>), '%hash ~~ .<true values>';
+ ok !(%h ~~ .<c d a>), '%hash ~~ .<not all true>';
+ ok !(%h ~~ .<c d f>), '%hash ~~ .<not all exist>';
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,39 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any .foo method truth>
+#L<S03/Smart matching/Any .foo(...) method truth>
+{
+ class Smartmatch::Tester {
+ method a { 4 };
+ method b($x) { 5 * $x };
+ method c { 0 };
+ }
+ my $t = Smartmatch::Tester.new();
+ ok ($t ~~ .a), '$obj ~~ .method calls the method (+)';
+ ok !($t ~~ .c), '$obj ~~ .method calls the method (-)';
+ ok ($t ~~ .b(3)), '$obj ~~ .method(arg) calls the method (true)';
+ ok ($t ~~ .b: 3), '$obj ~~ .method: arg calls the method (true)';
+ ok !($t ~~ .b(0)), '$obj ~~ .method(arg) calls the method (false)';
+ ok !($t ~~ .b: 0), '$obj ~~ .method: arg calls the method (false)';
+
+ # now change the same in when blocks, which also smart-match
+ my ($a, $b, $c) = 0 xx 3;
+ given $t {
+ when .a { $a = 1 };
+ }
+ given $t {
+ when .b(3) { $b = 1 };
+ }
+ given $t {
+ when .b(0) { $c = 1 };
+ }
+ ok $a, '.method in when clause';
+ ok $b, '.method(args) in when clause';
+ ok !$c, '..method(args) should not trigger when-block when false';
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,19 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any Num numeric equality>
+{
+ ok ('05' ~~ 5), '$something ~~ number numifies';
+ ok ('1.2' ~~ 1.2), '$thing ~~ number does numeric comparison';
+ # yes, this warns, but it should still be true
+ ok (Mu ~~ 0), 'Mu ~~ 0';
+ ok !(Mu ~~ 2.3), 'Mu ~~ $other_number';
+ ok (3+0i ~~ 3), 'Complex ~~ Num (+)';
+ ok !(3+1i ~~ 3), 'Complex ~~ Num (-)';
+ ok !(4+0i ~~ 3), 'Complex ~~ Num (-)';
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,36 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any Pair test object attribute>
+#?rakudo skip 'Any ~~ Pair'
+{
+ # ?."{X.key}" === ?X.value
+ # means:
+ # call the method with the name of X.key on the object, coerce to
+ # Bool, and check if it's the same as boolean value of X.value
+
+ class SmartmatchTest::AttrPair {
+ has $.a = 4;
+ has $.b = 'foo';
+ has $.c = Mu;
+ }
+ my $o = SmartmatchTest::AttrPair.new();
+ ok ($o ~~ :a(4)), '$obj ~~ Pair (Int, +)';
+ ok ($o ~~ :a(2)), '$obj ~~ Pair (Int, +)';
+ ok !($o ~~ :b(0)), '$obj ~~ Pair (different types)';
+ ok ($o ~~ :b<foo>), '$obj ~~ Pair (Str, +)';
+ ok ($o ~~ :b<ugh>), '$obj ~~ Pair (Str, -)';
+ ok ($o ~~ :c(Mu)), '$obj ~~ Pair (Mu, +)';
+ ok ($o ~~ :c(0)), '$obj ~~ Pair (0, +)';
+ ok !($o ~~ :b(Mu)), '$obj ~~ Pair (Mu, -)';
+ # not explicitly specced, but implied by the spec and decreed
+ # by TimToady: non-existing method or attribute dies:
+ # http://irclog.perlgeek.de/perl6/2009-07-06#i_1293199
+ dies_ok {$o ~~ :e(Mu)}, '$obj ~~ Pair, nonexistent, dies (1)';
+ dies_ok {$o ~~ :e(5)}, '$obj ~~ Pair, nonexistent, dies (2)';
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,16 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any Str string equality>
+{
+ ok(!("foo" !~~ "foo"), "!(foo ne foo)");
+ ok(("bar" !~~ "foo"), "bar ne foo)");
+ ok (4 ~~ '4'), 'string equality';
+ ok !(4 !~~ '4'), 'negated string equality';
+ ok (Mu ~~ ''), 'Mu ~~ ""';
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,22 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/Any .(...) sub call truth>
+{
+ my $t = sub { Bool::True };
+ my $f = sub { Bool::False };
+ my $mul = sub ($x) { $x * 2 };
+ my $div = sub ($x) { $x - 2 };
+
+ ok ($t ~~ .()), '~~ .() sub call truth (+)';
+ ok !($f ~~ .()), '~~ .() sub call truth (-)';
+ ok ($mul ~~ .(2)), '~~ .($args) sub call truth (+,1)';
+ ok !($mul ~~ .(0)), '~~ .($args) sub call truth (-,1)';
+ ok !($div ~~ .(2)), '~~ .($args) sub call truth (+,2)';
+ ok ($div ~~ .(0)), '~~ .($args) sub call truth (-,2)';
+}
+
+done_testing;
+
+# vim: ft=perl6
View
@@ -0,0 +1,20 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/type membership>
+{
+ class Dog {}
+ class Cat {}
+ class Chihuahua is Dog {} # i'm afraid class Pugs will get in the way ;-)
+ role SomeRole { };
+ class Something does SomeRole { };
+
+ ok (Chihuahua ~~ Dog), "chihuahua isa dog";
+ ok (Something ~~ SomeRole), 'something does dog';
+ ok !(Chihuahua ~~ Cat), "chihuahua is not a cat";
+}
+
+done_testing;
+
+# vim: ft=perl6
@@ -0,0 +1,54 @@
+use v6;
+use Test;
+plan *;
+
+#L<S03/Smart matching/arrays are comparable>
+{
+ ok((("blah", "blah") ~~ ("blah", "blah")), "qw/blah blah/ .eq");
+ ok(!((1, 2) ~~ (1, 1)), "1 2 !~~ 1 1");
+ ok(!((1, 2, 3) ~~ (1, 2)), "1 2 3 !~~ 1 2");
+ ok(!((1, 2) ~~ (1, 2, 3)), "1 2 !~~ 1 2 3");
+ ok(!(list() ~~ list(1)), "array smartmatch boundary conditions");
+ ok(!(list(1) ~~ list()), "array smartmatch boundary conditions");
+ ok((list() ~~ list()), "array smartmatch boundary conditions");
+ ok((list(1) ~~ list(1)), "array smartmatch boundary conditions");
+ ok((1,2,3,4) ~~ (1,*), 'array smartmatch dwims * at end');
+ ok((1,2,3,4) ~~ (1,*,*), 'array smartmatch dwims * at end (many *s)');
+ ok((1,2,3,4) ~~ (*,4), 'array smartmatch dwims * at start');
+ ok((1,2,3,4) ~~ (*,*,4), 'array smartmatch dwims * at start (many *s)');
+ ok((1,2,3,4) ~~ (1,*,3,4), 'array smartmatch dwims * 1 elem');
+ ok((1,2,3,4) ~~ (1,*,*,3,4), 'array smartmatch dwims * 1 elem (many *s)');
+ ok((1,2,3,4) ~~ (1,*,4), 'array smartmatch dwims * many elems');
+ ok((1,2,3,4) ~~ (1,*,*,4), 'array smartmatch dwims * many elems (many *s)');
+ ok((1,2,3,4) ~~ (*,3,*), 'array smartmatch dwims * at start and end');
+ ok((1,2,3,4) ~~ (*,*,3,*,*), 'array smartmatch dwims * at start and end (many *s)');
+ ok((1,2,3,4) ~~ (*,1,2,3,4), 'array smartmatch dwims * can match nothing at start');
+ ok((1,2,3,4) ~~ (*,*,1,2,3,4), 'array smartmatch dwims * can match nothing at start (many *s)');
+ ok((1,2,3,4) ~~ (1,2,*,3,4), 'array smartmatch dwims * can match nothing in middle');
+ ok((1,2,3,4) ~~ (1,2,*,*,3,4), 'array smartmatch dwims * can match nothing in middle (many *s)');
+ ok((1,2,3,4) ~~ (1,2,3,4,*), 'array smartmatch dwims * can match nothing at end');
+ ok((1,2,3,4) ~~ (1,2,3,4,*,*), 'array smartmatch dwims * can match nothing at end (many *s)');
+ ok(!((1,2,3,4) ~~ (1,*,3)), '* dwimming does not cause craziness');
+ ok(!((1,2,3,4) ~~ (*,5)), '* dwimming does not cause craziness');
+ ok(!((1,2,3,4) ~~ (1,3,*)), '* dwimming does not cause craziness');
+
+ # now try it with arrays as well
+ my @a = 1, 2, 3;
+ my @b = 1, 2, 4;
+ my @m = (*, 2, *); # m as "magic" ;-)
+
+ ok (@a ~~ @a), 'Basic smartmatching on arrays (positive)';
+ ok (@a !~~ @b), 'Basic smartmatching on arrays (negative)';
+ ok (@b !~~ @a), 'Basic smartmatching on arrays (negative)';
+ ok (@a ~~ @m), 'Whatever dwimminess in arrays';
+ ok (@a ~~ (1, 2, 3)), 'smartmatch Array ~~ List';
+ ok ((1, 2, 3) ~~ @a), 'smartmatch List ~~ Array';
+ ok ((1, 2, 3) ~~ @m), 'smartmatch List ~~ Array with dwim';
+
+ ok (1 ~~ *,1,*), 'smartmatch with Array RHS co-erces LHS to list';
+ ok (1..10 ~~ *,5,*), 'smartmatch with Array RHS co-erces LHS to list';
+}
+
+done_testing;
+
+# vim: ft=perl6
Oops, something went wrong.

0 comments on commit e67eb0c

Please sign in to comment.