Add Set/Bag/Mix(Hashes) sanity tests

rakudo · Mar 9, 2015 · b8a4665 · b8a4665
1 parent cd7c31c
commit b8a4665
Showing 1 changed file with 100 additions and 1 deletion.
diff --git a/t/01-sanity/22-KEY.t b/t/01-sanity/22-KEY.t
@@ -2,7 +2,7 @@ use v6;
 
 use Test;
 
-plan 72;
+plan 120;
 
 my %h            = a => 42, b => 666;
 my Int %hi       = a => 42, b => 666;
@@ -77,3 +77,102 @@ for $%h, Any, $%hi, Int, $%hia, Int -> \h, \T {
     is $a.DELETE-KEY("a"), Nil, "\$a.DELETE-KEY (undefined)";  # not sure ok
     ok !$a.EXISTS-KEY("a"),     "\$a.EXISTS-KEY (after delete)";
 }
+
+{
+    my $a = 42;
+    my $s = <a b c>.Set;
+    ok $s.EXISTS-KEY("a"),   "\$s.EXISTS-KEY";
+    ok !$s.EXISTS-KEY("d"),  "!\$s.EXISTS-KEY";
+    is $s.AT-KEY("a"), True, "\$s.AT-KEY";
+# todo, no fudging in sanity
+#    throws_like { $s.BIND-KEY("a",$a) },X::Bind,:target<Set>,"\$s.BIND-KEY";
+    is $s.AT-KEY("a"), True, "\$s.AT-KEY (after bind)";
+    throws_like { $s.DELETE-KEY("a") },
+      X::Immutable, :method<DELETE-KEY>, :typename<Set>, "\$s.DELETE-KEY";
+    is $s.AT-KEY("a"), True, "\$s.AT-KEY (after delete)";
+    throws_like { $s.ASSIGN-KEY("a",False) },
+      X::Assignment::RO, :typename<Set>, "\$s.ASSIGN-KEY";
+    is $s.AT-KEY("a"), True, "\$s.AT-KEY (after assignment)";
+}
+
+{
+    my $a = True;
+    my $sh = <a b c>.SetHash;
+    ok $sh.EXISTS-KEY("a"),   "\$sh.EXISTS-KEY";
+    ok !$sh.EXISTS-KEY("d"),  "!\$sh.EXISTS-KEY";
+    is $sh.AT-KEY("a"), True, "\$sh.AT-KEY";
+# todo, no fudging in sanity
+#    throws_like { $sh.BIND-KEY("a",$a) },
+#      X::Bind,:target<SetHash>,"\$sh.BIND-KEY";
+    is $sh.AT-KEY("a"),          True, "\$sh.AT-KEY (after bind)";
+    is $sh.DELETE-KEY("a"),      True, "\$sh.DELETE-KEY";
+    is $sh.EXISTS-KEY("a"),     False, "\$sh.EXISTS-KEY (after delete)";
+    is $sh.ASSIGN-KEY("a",True), True, "\$sh.ASSIGN-KEY";
+    is $sh.AT-KEY("a"),          True, "\$sh.AT-KEY (after assignment)";
+}
+
+{
+    my $a = 42;
+    my $b = <a b b c c c>.Bag;
+    ok $b.EXISTS-KEY("a"),  "\$b.EXISTS-KEY";
+    ok !$b.EXISTS-KEY("d"), "!\$b.EXISTS-KEY";
+    is $b.AT-KEY("a"), 1,   "\$b.AT-KEY";
+# todo, no fudging in sanity
+#    throws_like { $b.BIND-KEY("a",$a) },X::Bind,:target<Bag>,"\$b.BIND-KEY";
+    is $b.AT-KEY("a"), 1, "\$b.AT-KEY (after bind)";
+    throws_like { $b.DELETE-KEY("a") },
+      X::Immutable, :method<DELETE-KEY>, :typename<Bag>, "\$b.DELETE-KEY";
+    is $b.AT-KEY("a"), 1, "\$b.AT-KEY (after delete)";
+    throws_like { $b.ASSIGN-KEY("a",42) },
+      X::Assignment::RO, :typename<Bag>, "\$b.ASSIGN-KEY";
+    is $b.AT-KEY("a"), 1, "\$b.AT-KEY (after assignment)";
+}
+
+{
+    my $a = 42;
+    my $bh = <a b b c c c>.BagHash;
+    ok $bh.EXISTS-KEY("a"),   "\$bh.EXISTS-KEY";
+    ok !$bh.EXISTS-KEY("d"),  "!\$bh.EXISTS-KEY";
+    is $bh.AT-KEY("a"), 1, "\$bh.AT-KEY";
+# todo, no fudging in sanity
+#    throws_like { $bh.BIND-KEY("a",$a) },
+#      X::Bind,:target<BagHash>,"\$bh.BIND-KEY";
+    is $bh.AT-KEY("a"),          1, "\$bh.AT-KEY (after bind)";
+    is $bh.DELETE-KEY("a"),      1, "\$bh.DELETE-KEY";
+    is $bh.EXISTS-KEY("a"),  False, "\$bh.EXISTS-KEY (after delete)";
+    is $bh.ASSIGN-KEY("a",$a),  $a, "\$bh.ASSIGN-KEY";
+    is $bh.AT-KEY("a"),         $a, "\$bh.EXISTS-KEY (after assignment)";
+}
+
+{
+    my $a = 42;
+    my $m = <a b b c c c>.Mix;
+    ok $m.EXISTS-KEY("a"),  "\$m.EXISTS-KEY";
+    ok !$m.EXISTS-KEY("d"), "!\$m.EXISTS-KEY";
+    is $m.AT-KEY("a"), 1,   "\$m.AT-KEY";
+# todo, no fudging in sanity
+#    throws_like { $m.BIND-KEY("a",$a) },X::Bind,:target<Mix>,"\$m.BIND-KEY";
+    is $m.AT-KEY("a"), 1, "\$m.AT-KEY (after bind)";
+    throws_like { $m.DELETE-KEY("a") },
+      X::Immutable, :method<DELETE-KEY>, :typename<Mix>, "\$m.DELETE-KEY";
+    is $m.AT-KEY("a"), 1, "\$m.AT-KEY (after delete)";
+    throws_like { $m.ASSIGN-KEY("a",42) },
+      X::Assignment::RO, :typename<Mix>, "\$m.ASSIGN-KEY";
+    is $m.AT-KEY("a"), 1, "\$m.AT-KEY (after assignment)";
+}
+
+{
+    my $a = 42.5;
+    my $mh = <a b b c c c>.BagHash;
+    ok $mh.EXISTS-KEY("a"),   "\$bh.EXISTS-KEY";
+    ok !$mh.EXISTS-KEY("d"),  "!\$bh.EXISTS-KEY";
+    is $mh.AT-KEY("a"), 1, "\$bh.AT-KEY";
+# todo, no fudging in sanity
+#    throws_like { $mh.BIND-KEY("a",$a) },
+#      X::Bind,:target<MixHash>,"\$mh.BIND-KEY";
+    is $mh.AT-KEY("a"),          1, "\$mh.AT-KEY (after bind)";
+    is $mh.DELETE-KEY("a"),      1, "\$mh.DELETE-KEY";
+    is $mh.EXISTS-KEY("a"),  False, "\$mh.EXISTS-KEY (after delete)";
+    is $mh.ASSIGN-KEY("a",$a),  $a, "\$mh.ASSIGN-KEY";
+    is $mh.AT-KEY("a"),         $a, "\$mh.EXISTS-KEY (after assignment)";
+}