Skip to content

Commit

Permalink
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
Show file tree
Hide file tree
Showing 2 changed files with 160 additions and 0 deletions.
84 changes: 84 additions & 0 deletions S02-builtin_data_types/bag.t
@@ -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
76 changes: 76 additions & 0 deletions S02-builtin_data_types/set.t
@@ -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

0 comments on commit 8e4955e

Please sign in to comment.