Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
Added tests for Sets and Bags.
- Loading branch information
Kodi Arfer
authored and
Kodi Arfer
committed
Sep 15, 2010
1 parent
d71f4c3
commit 8e4955e
Showing
2 changed files
with
160 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,84 @@ | ||
use v6; | ||
use Test; | ||
|
||
plan 33; | ||
|
||
sub showkv($x) { | ||
$x.keys.sort.map({ $^k ~ ':' ~ $x{$^k} }).join(' ') | ||
} | ||
|
||
# L<S02/Immutable types/'the bag listop'> | ||
|
||
{ | ||
my $b = bag <a foo a a a a b foo>; | ||
isa_ok $b, Bag, '&bag produces a Bag'; | ||
is showkv($b), 'a:5 b:1 foo:2', '...with the right elements'; | ||
|
||
is $b<a>, 5, 'Single-key subscript (existing element)'; | ||
is $b<santa>, 0, 'Single-key subscript (nonexistent element)'; | ||
ok $b.exists('a'), '.exists with existing element'; | ||
nok $b.exists('santa'), '.exists with nonexistent element'; | ||
|
||
dies_ok { $b<a> = 5 }, "Can't assign to an element (Bags are immutable)"; | ||
dies_ok { $b.keys = <c d> }, "Can't assign to .keys"; | ||
dies_ok { $b.values = 3, 4 }, "Can't assign to .values"; | ||
|
||
is ([+] $b<a b>), 6, 'Multiple-element access'; | ||
is ([+] $b<a santa b easterbunny>), 6, 'Multiple-element access (with nonexistent elements)'; | ||
|
||
is $b.elems, 8, '.elems gives sum of values'; | ||
is +$b, 8, '+$bag gives sum of values'; | ||
} | ||
|
||
{ | ||
my $b = bag 'a', False, 2, 'a', False, False; | ||
my @ks = $b.keys; | ||
is @ks.grep(Int)[0], 2, 'Int keys are left as Ints'; | ||
is @ks.grep(* eqv False).elems, 1, 'Bool keys are left as Bools'; | ||
is @ks.grep(Str)[0], 'a', 'And Str keys are permitted in the same set'; | ||
is $b{2, 'a', False}.sort.join(' '), '1 2 3', 'All keys have the right values'; | ||
} | ||
|
||
{ | ||
my %h = bag <a b o p a p o o>; | ||
ok %h ~~ Hash, 'A hash to which a Bag has been assigned remains a hash'; | ||
is showkv(%h), 'a:2 b:1 o:3 p:2', '...with the right elements'; | ||
} | ||
|
||
{ | ||
my $b = bag set <foo bar foo bar baz foo>; | ||
isa_ok $b, Bag, '&bag given a Set produces a Bag'; | ||
is showkv($b), 'bar:1 baz:1 foo:1', '... with the right elements'; | ||
} | ||
|
||
# L<S02/Names and Variables/'C<%x> may be bound to'> | ||
|
||
{ | ||
my %b := bag <a b c b>; | ||
isa_ok %b, Bag, 'A Bag bound to a %var is a Bag'; | ||
is showkv(%b), 'a:1 b:2 c:1', '...with the right elements'; | ||
|
||
is %b<b>, 2, 'Single-key subscript (existing element)'; | ||
is %b<santa>, 0, 'Single-key subscript (nonexistent element)'; | ||
|
||
dies_ok { %b<a> = 1 }, "Can't assign to an element (Bags are immutable)"; | ||
dies_ok { %b = bag <a b> }, "Can't assign to a %var implemented by Bag"; | ||
} | ||
|
||
# L<S32::Containers/Bag/pick> | ||
|
||
{ | ||
my $b = bag <a b b>; | ||
|
||
my @a = $b.pick: *; | ||
is +@a, 3, '.pick(*) returns the right number of items'; | ||
is @a.grep(* eq 'a').elems, 1, '.pick(*) (1)'; | ||
is @a.grep(* eq 'b').elems, 2, '.pick(*) (2)'; | ||
|
||
@a = $b.pick: 100, :replace; | ||
is +@a, 100, '.pick(100, :replace) returns 100 items'; | ||
ok 2 < @a.grep(* eq 'a') < 75, '.pick(100, :replace) (1)'; | ||
ok @a.grep(* eq 'a') + 2 < @a.grep(* eq 'b'), '.pick(100, :replace) (2)'; | ||
} | ||
|
||
# vim: ft=perl6 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,76 @@ | ||
use v6; | ||
use Test; | ||
|
||
plan 29; | ||
|
||
sub showset($s) { $s.keys.sort.join(' ') } | ||
|
||
# L<S02/Immutable types/'the set listop'> | ||
|
||
{ | ||
my $s = set <a b foo>; | ||
isa_ok $s, Set, '&set produces a Set'; | ||
is showset($s), 'a b foo', '...with the right elements'; | ||
|
||
is $s<a>, True, 'Single-key subscript (existing element)'; | ||
is $s<santa>, False, 'Single-key subscript (nonexistent element)'; | ||
is $s.exists('a'), True, '.exists with existing element'; | ||
is $s.exists('santa'), False, '.exists with nonexistent element'; | ||
|
||
dies_ok { $s<a> = True }, "Can't assign to an element (Sets are immutable)"; | ||
dies_ok { $s.keys = <c d> }, "Can't assign to .keys"; | ||
dies_ok { $s.values = <True False> }, "Can't assign to .values"; | ||
|
||
is ($s<a b>).grep(?*).elems, 2, 'Multiple-element access'; | ||
is ($s<a santa b easterbunny>).grep(?*).elems, 2, 'Multiple-element access (with nonexistent elements)'; | ||
|
||
is $s.elems, 3, '.elems gives number of keys'; | ||
is +$s, 3, '+$set gives number of keys'; | ||
} | ||
|
||
{ | ||
my $s = set 2, 'a', False; | ||
my @ks = $s.keys; | ||
is @ks.grep(Int)[0], 2, 'Int keys are left as Ints'; | ||
is @ks.grep(* eqv False).elems, 1, 'Bool keys are left as Bools'; | ||
is @ks.grep(Str)[0], 'a', 'And Str keys are permitted in the same set'; | ||
is +$s, 3, 'Keys are counted correctly even when a key is False'; | ||
} | ||
|
||
{ | ||
my %h = set <a b o p a p o o>; | ||
ok %h ~~ Hash, 'A hash to which a Set has been assigned remains a hash'; | ||
is %h.keys.sort.join, 'abop', '...with the right keys'; | ||
is %h.values, (True, True, True, True), '...and values all True'; | ||
} | ||
|
||
{ | ||
my $s = set <foo bar foo bar baz foo>; | ||
is showset($s), 'bar baz foo', '&set discards duplicates'; | ||
} | ||
|
||
# L<S02/Names and Variables/'C<%x> may be bound to'> | ||
|
||
{ | ||
my %s := set <a b c b>; | ||
isa_ok %s, Set, 'A Set bound to a %var is a Set'; | ||
is showset(%s), 'a b c', '...with the right elements'; | ||
|
||
is %s<a>, True, 'Single-key subscript (existing element)'; | ||
is %s<santa>, False, 'Single-key subscript (nonexistent element)'; | ||
|
||
dies_ok { %s<a> = True }, "Can't assign to an element (Sets are immutable)"; | ||
dies_ok { %s = a => True, b => True }, "Can't assign to a %var implemented by Set"; | ||
} | ||
|
||
# L<S32::Containers/Set/pick> | ||
|
||
{ | ||
my $s = set <a b c d e f g h>; | ||
my @a = $s.pick: *; | ||
is @a.sort.join, 'abcdefgh', 'Set.pick(*) gets all elements'; | ||
isnt @a.join, 'abcdefgh', 'Set.pick(*) returns elements in a random order'; | ||
# There's only a 1/40_320 chance of that test failing by chance alone. | ||
} | ||
|
||
# vim: ft=perl6 |