Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Part 2 of bringing Bag/Set tests up to spec again
  • Loading branch information
@lizmat
lizmat committed Oct 3, 2013
2 parents 3ca73a7 + 7c5ddf1 commit 109ff98
Show file tree
Hide file tree
Showing 9 changed files with 336 additions and 336 deletions.
8 changes: 4 additions & 4 deletions S02-types/bag.t
View file
Expand Up @@ -146,14 +146,14 @@ sub showkv($x) {
}

{
my $b = bag KeySet.new(<foo bar foo bar baz foo>);
isa_ok $b, Bag, '&Bag.new given a KeySet produces a Bag';
my $b = bag SetHash.new(<foo bar foo bar baz foo>);
isa_ok $b, Bag, '&Bag.new given a SetHash produces a Bag';
is +$b, 1, "... with one element";
}

{
my $b = bag KeyBag.new(<foo bar foo bar baz foo>);
isa_ok $b, Bag, '&Bag.new given a KeyBag produces a Bag';
my $b = bag BagHash.new(<foo bar foo bar baz foo>);
isa_ok $b, Bag, '&Bag.new given a BagHash produces a Bag';
is +$b, 1, "... with one element";
}

Expand Down
160 changes: 80 additions & 80 deletions S02-types/baghash.t
View file
Expand Up @@ -5,7 +5,7 @@ plan 172;

# L<S02/Mutable types/KeyHash of UInt>

# A KeyBag is a KeyHash of UInt, i.e. the values are positive Int
# A BagHash is a KeyHash of UInt, i.e. the values are positive Int

sub showkv($x) {
$x.keys.sort.map({"$_:{$x{$_}}"}).join(' ')
Expand All @@ -15,8 +15,8 @@ sub showkv($x) {

{
say "We do get here, right?";
my $b = KeyBag.new("a", "foo", "a", "a", "a", "a", "b", "foo");
isa_ok $b, KeyBag, 'we got a KeyBag';
my $b = BagHash.new("a", "foo", "a", "a", "a", "a", "b", "foo");
isa_ok $b, BagHash, 'we got a BagHash';
is showkv($b), 'a:5 b:1 foo:2', '...with the right elements';

is $b.default, 0, "Defaults to 0";
Expand All @@ -29,8 +29,8 @@ sub showkv($x) {

is $b.values.elems, 3, "Values returns the correct number of values";
is ([+] $b.values), 8, "Values returns the correct sum";
ok ?$b, "Bool returns True if there is something in the KeyBag";
nok ?KeyBag.new(), "Bool returns False if there is nothing in the KeyBag";
ok ?$b, "Bool returns True if there is something in the BagHash";
nok ?BagHash.new(), "Bool returns False if there is nothing in the BagHash";

my $hash;
lives_ok { $hash = $b.hash }, ".hash doesn't die";
Expand Down Expand Up @@ -69,47 +69,47 @@ sub showkv($x) {
}

{
ok (KeyBag.new: <a b c>) ~~ (KeyBag.new: <a b c>), "Identical bags smartmatch with each other";
ok (KeyBag.new: <a b c c>) ~~ (KeyBag.new: <a b c c>), "Identical bags smartmatch with each other";
nok (KeyBag.new: <b c>) ~~ (KeyBag.new: <a b c>), "Subset does not smartmatch";
nok (KeyBag.new: <a b c>) ~~ (KeyBag.new: <a b c c>), "Subset (only quantity different) does not smartmatch";
nok (KeyBag.new: <a b c d>) ~~ (KeyBag.new: <a b c>), "Superset does not smartmatch";
nok (KeyBag.new: <a b c c c>) ~~ (KeyBag.new: <a b c c>), "Superset (only quantity different) does not smartmatch";
nok "a" ~~ (KeyBag.new: <a b c>), "Smartmatch is not element of";
ok (KeyBag.new: <a b c>) ~~ KeyBag, "Type-checking smartmatch works";

ok (set <a b c>) ~~ (KeyBag.new: <a b c>), "Set smartmatches with equivalent KeyBag.new:";
nok (set <a a a b c>) ~~ (KeyBag.new: <a a a b c>), "... but not if the Bag has greater quantities";
nok (set <a b c>) ~~ KeyBag, "Type-checking smartmatch works";
ok (BagHash.new: <a b c>) ~~ (BagHash.new: <a b c>), "Identical bags smartmatch with each other";
ok (BagHash.new: <a b c c>) ~~ (BagHash.new: <a b c c>), "Identical bags smartmatch with each other";
nok (BagHash.new: <b c>) ~~ (BagHash.new: <a b c>), "Subset does not smartmatch";
nok (BagHash.new: <a b c>) ~~ (BagHash.new: <a b c c>), "Subset (only quantity different) does not smartmatch";
nok (BagHash.new: <a b c d>) ~~ (BagHash.new: <a b c>), "Superset does not smartmatch";
nok (BagHash.new: <a b c c c>) ~~ (BagHash.new: <a b c c>), "Superset (only quantity different) does not smartmatch";
nok "a" ~~ (BagHash.new: <a b c>), "Smartmatch is not element of";
ok (BagHash.new: <a b c>) ~~ BagHash, "Type-checking smartmatch works";

ok (set <a b c>) ~~ (BagHash.new: <a b c>), "Set smartmatches with equivalent BagHash.new:";
nok (set <a a a b c>) ~~ (BagHash.new: <a a a b c>), "... but not if the Bag has greater quantities";
nok (set <a b c>) ~~ BagHash, "Type-checking smartmatch works";
}

{
isa_ok "a".KeyBag, KeyBag, "Str.KeyBag makes a KeyBag";
is showkv("a".KeyBag), 'a:1', "'a'.KeyBag is bag a";
isa_ok "a".BagHash, BagHash, "Str.BagHash makes a BagHash";
is showkv("a".BagHash), 'a:1', "'a'.BagHash is bag a";

isa_ok (a => 100000).KeyBag, KeyBag, "Pair.KeyBag makes a KeyBag";
is showkv((a => 100000).KeyBag), 'a:100000', "(a => 100000).KeyBag is bag a:100000";
is showkv((a => 0).KeyBag), '', "(a => 0).KeyBag is the empty bag";
isa_ok (a => 100000).BagHash, BagHash, "Pair.BagHash makes a BagHash";
is showkv((a => 100000).BagHash), 'a:100000', "(a => 100000).BagHash is bag a:100000";
is showkv((a => 0).BagHash), '', "(a => 0).BagHash is the empty bag";

isa_ok <a b c>.KeyBag, KeyBag, "<a b c>.KeyBag makes a KeyBag";
is showkv(<a b c a>.KeyBag), 'a:2 b:1 c:1', "<a b c a>.KeyBag makes the bag a:2 b:1 c:1";
is showkv(["a", "b", "c", "a"].KeyBag), 'a:2 b:1 c:1', "[a b c a].KeyBag makes the bag a:2 b:1 c:1";
is showkv([a => 3, b => 0, 'c', 'a'].KeyBag), 'a:4 c:1', "[a => 3, b => 0, 'c', 'a'].KeyBag makes the bag a:4 c:1";
isa_ok <a b c>.BagHash, BagHash, "<a b c>.BagHash makes a BagHash";
is showkv(<a b c a>.BagHash), 'a:2 b:1 c:1', "<a b c a>.BagHash makes the bag a:2 b:1 c:1";
is showkv(["a", "b", "c", "a"].BagHash), 'a:2 b:1 c:1', "[a b c a].BagHash makes the bag a:2 b:1 c:1";
is showkv([a => 3, b => 0, 'c', 'a'].BagHash), 'a:4 c:1', "[a => 3, b => 0, 'c', 'a'].BagHash makes the bag a:4 c:1";

isa_ok {a => 2, b => 4, c => 0}.KeyBag, KeyBag, "{a => 2, b => 4, c => 0}.KeyBag makes a KeyBag";
is showkv({a => 2, b => 4, c => 0}.KeyBag), 'a:2 b:4', "{a => 2, b => 4, c => 0}.KeyBag makes the bag a:2 b:4";
isa_ok {a => 2, b => 4, c => 0}.BagHash, BagHash, "{a => 2, b => 4, c => 0}.BagHash makes a BagHash";
is showkv({a => 2, b => 4, c => 0}.BagHash), 'a:2 b:4', "{a => 2, b => 4, c => 0}.BagHash makes the bag a:2 b:4";
}

{
my $s = KeyBag.new(<a a b foo>);
my $s = BagHash.new(<a a b foo>);
is $s<a>:exists, True, ':exists with existing element';
is $s<santa>:exists, False, ':exists with nonexistent element';
is $s<a>:delete, 2, ':delete works on KeyBag';
is $s<a>:delete, 2, ':delete works on BagHash';
is showkv($s), 'b:1 foo:1', '...and actually deletes';
}

{
my $b = KeyBag.new('a', False, 2, 'a', False, False);
my $b = BagHash.new('a', False, 2, 'a', False, False);
my @ks = $b.keys;
#?niecza 3 skip "Non-Str keys NYI"
is @ks.grep(Int)[0], 2, 'Int keys are left as Ints';
Expand All @@ -127,20 +127,20 @@ sub showkv($x) {
}

{
my $b = KeyBag.new(<a b o p a p o o>);
isa_ok $b, KeyBag, '&KeyBag.new given an array of strings produces a KeyBag';
my $b = BagHash.new(<a b o p a p o o>);
isa_ok $b, BagHash, '&BagHash.new given an array of strings produces a BagHash';
is showkv($b), 'a:2 b:1 o:3 p:2', '...with the right elements';
}

{
my $b = KeyBag.new([ foo => 10, bar => 17, baz => 42, santa => 0 ]);
isa_ok $b, KeyBag, '&KeyBag.new given an array of pairs produces a KeyBag';
my $b = BagHash.new([ foo => 10, bar => 17, baz => 42, santa => 0 ]);
isa_ok $b, BagHash, '&BagHash.new given an array of pairs produces a BagHash';
is +$b, 1, "... with one element";
}

{
my $b = KeyBag.new({ foo => 10, bar => 17, baz => 42, santa => 0 }.hash);
isa_ok $b, KeyBag, '&KeyBag.new given a Hash produces a KeyBag';
my $b = BagHash.new({ foo => 10, bar => 17, baz => 42, santa => 0 }.hash);
isa_ok $b, BagHash, '&BagHash.new given a Hash produces a BagHash';
#?rakudo todo "Needs to catch up with spec"
is +$b, 4, "... with four elements";
#?niecza todo "Non-string bag elements NYI"
Expand All @@ -149,43 +149,43 @@ sub showkv($x) {
}

{
my $b = KeyBag.new({ foo => 10, bar => 17, baz => 42, santa => 0 });
isa_ok $b, KeyBag, '&KeyBag.new given a Hash produces a KeyBag';
my $b = BagHash.new({ foo => 10, bar => 17, baz => 42, santa => 0 });
isa_ok $b, BagHash, '&BagHash.new given a Hash produces a BagHash';
is +$b, 1, "... with one element";
}

{
my $b = KeyBag.new(set <foo bar foo bar baz foo>);
isa_ok $b, KeyBag, '&KeyBag.new given a Set produces a KeyBag';
my $b = BagHash.new(set <foo bar foo bar baz foo>);
isa_ok $b, BagHash, '&BagHash.new given a Set produces a BagHash';
is +$b, 1, "... with one element";
}

{
my $b = KeyBag.new(KeySet.new(<foo bar foo bar baz foo>));
isa_ok $b, KeyBag, '&KeyBag.new given a KeySet produces a KeyBag';
my $b = BagHash.new(SetHash.new(<foo bar foo bar baz foo>));
isa_ok $b, BagHash, '&BagHash.new given a SetHash produces a BagHash';
is +$b, 1, "... with one element";
}

{
my $b = KeyBag.new(bag <foo bar foo bar baz foo>);
isa_ok $b, KeyBag, '&KeyBag.new given a Bag produces a KeyBag';
my $b = BagHash.new(bag <foo bar foo bar baz foo>);
isa_ok $b, BagHash, '&BagHash.new given a Bag produces a BagHash';
is +$b, 1, "... with one element";
}

# Not sure how one should do this with the new KeyBag constructor
# Not sure how one should do this with the new BagHash constructor
# {
# my $b = KeyBag.new(set <foo bar foo bar baz foo>);
# my $b = BagHash.new(set <foo bar foo bar baz foo>);
# $b<bar> += 2;
# my $c = KeyBag.new($b);
# isa_ok $c, KeyBag, '&KeyBag.new given a KeyBag produces a KeyBag';
# my $c = BagHash.new($b);
# isa_ok $c, BagHash, '&BagHash.new given a BagHash produces a BagHash';
# is showkv($c), 'bar:3 baz:1 foo:1', '... with the right elements';
# $c<manning> = 10;
# is showkv($c), 'bar:3 baz:1 foo:1 manning:10', 'Creating a new element works';
# is showkv($b), 'bar:3 baz:1 foo:1', '... and does not affect the original KeyBag';
# is showkv($b), 'bar:3 baz:1 foo:1', '... and does not affect the original BagHash';
# }

{
my $b = { foo => 10, bar => 1, baz => 2}.KeyBag;
my $b = { foo => 10, bar => 1, baz => 2}.BagHash;

# .list is just the keys, as per TimToady:
# http://irclog.perlgeek.de/perl6/2012-02-07#i_5112706
Expand All @@ -204,27 +204,27 @@ sub showkv($x) {
}

{
my $b = { foo => 10000000000, bar => 17, baz => 42 }.KeyBag;
my $b = { foo => 10000000000, bar => 17, baz => 42 }.BagHash;
my $s;
my $c;
lives_ok { $s = $b.perl }, ".perl lives";
isa_ok $s, Str, "... and produces a string";
ok $s.chars < 1000, "... of reasonable length";
lives_ok { $c = eval $s }, ".perl.eval lives";
isa_ok $c, KeyBag, "... and produces a KeyBag";
isa_ok $c, BagHash, "... and produces a BagHash";
is showkv($c), showkv($b), "... and it has the correct values";
}

{
my $b = { foo => 2, bar => 3, baz => 1 }.KeyBag;
my $b = { foo => 2, bar => 3, baz => 1 }.BagHash;
my $s;
lives_ok { $s = $b.Str }, ".Str lives";
isa_ok $s, Str, "... and produces a string";
is $s.split(" ").sort.join(" "), "bar bar bar baz foo foo", "... which only contains bar baz and foo with the proper counts and separated by spaces";
}

{
my $b = { foo => 10000000000, bar => 17, baz => 42 }.KeyBag;
my $b = { foo => 10000000000, bar => 17, baz => 42 }.BagHash;
my $s;
lives_ok { $s = $b.gist }, ".gist lives";
isa_ok $s, Str, "... and produces a string";
Expand All @@ -237,8 +237,8 @@ sub showkv($x) {
# L<S02/Names and Variables/'C<%x> may be bound to'>

{
my %b := KeyBag.new("a", "b", "c", "b");
isa_ok %b, KeyBag, 'A KeyBag bound to a %var is a KeyBag';
my %b := BagHash.new("a", "b", "c", "b");
isa_ok %b, BagHash, 'A BagHash bound to a %var is a BagHash';
is showkv(%b), 'a:1 b:2 c:1', '...with the right elements';

is %b<b>, 2, 'Single-key subscript (existing element)';
Expand All @@ -248,10 +248,10 @@ sub showkv($x) {
is %b<a>, 4, "... and gets the correct value";
}

# L<S32::Containers/KeyBag/roll>
# L<S32::Containers/BagHash/roll>

{
my $b = KeyBag.new("a", "b", "b");
my $b = BagHash.new("a", "b", "b");

my $a = $b.roll;
ok $a eq "a" || $a eq "b", "We got one of the two choices";
Expand All @@ -267,7 +267,7 @@ sub showkv($x) {
}

{
my $b = {"a" => 100000000000, "b" => 1}.KeyBag;
my $b = {"a" => 100000000000, "b" => 1}.BagHash;

my $a = $b.roll;
ok $a eq "a" || $a eq "b", "We got one of the two choices (and this was pretty quick, we hope!)";
Expand All @@ -278,10 +278,10 @@ sub showkv($x) {
ok @a.grep(* eq 'b') < 3, '.roll(100) (2)';
}

# L<S32::Containers/KeyBag/pick>
# L<S32::Containers/BagHash/pick>

{
my $b = KeyBag.new("a", "b", "b");
my $b = BagHash.new("a", "b", "b");

my $a = $b.pick;
ok $a eq "a" || $a eq "b", "We got one of the two choices";
Expand All @@ -298,7 +298,7 @@ sub showkv($x) {
}

{
my $b = {"a" => 100000000000, "b" => 1}.KeyBag;
my $b = {"a" => 100000000000, "b" => 1}.BagHash;

my $a = $b.pick;
ok $a eq "a" || $a eq "b", "We got one of the two choices (and this was pretty quick, we hope!)";
Expand All @@ -312,7 +312,7 @@ sub showkv($x) {
#?rakudo skip "'is ObjectType' NYI"
#?niecza skip "Trait name not available on variables"
{
my %h is KeyBag = a => 1, b => 0, c => 2;
my %h is BagHash = a => 1, b => 0, c => 2;
#?rakudo todo 'todo'
nok %h<b>:exists, '"b", initialized to zero, does not exist';
#?rakudo todo 'todo'
Expand All @@ -327,7 +327,7 @@ sub showkv($x) {
#?rakudo skip "'is ObjectType' NYI"
#?niecza skip "Trait name not available on variables"
{
my %h is KeyBag = a => 1, b => 0, c => 2;
my %h is BagHash = a => 1, b => 0, c => 2;

lives_ok { %h<c> = 0 }, 'can set an item to 0';
#?rakudo todo 'todo'
Expand All @@ -345,7 +345,7 @@ sub showkv($x) {
#?rakudo skip "'is ObjectType' NYI"
#?niecza skip "Trait name not available on variables"
{
my %h is KeyBag = a => 1, c => 1;
my %h is BagHash = a => 1, c => 1;

lives_ok { %h<c>++ }, 'can "add" (++) an existing item';
is %h<c>, 2, '++ on an existing item increments the counter';
Expand All @@ -367,28 +367,28 @@ sub showkv($x) {

#?niecza skip "Trait name not available on variables"
{
my %h of KeyBag;
ok %h.of.perl eq 'KeyBag', 'is the hash really a KeyBag';
my %h of BagHash;
ok %h.of.perl eq 'BagHash', 'is the hash really a BagHash';
#?rakudo 2 todo 'in flux'
lives_ok { %h = bag <a b c d c b> }, 'Assigning a Bag to a KeyBag';
lives_ok { %h = bag <a b c d c b> }, 'Assigning a Bag to a BagHash';
is %h.keys.sort.map({ $^k ~ ':' ~ %h{$k} }).join(' '),
'a:1 b:2 c:2 d:1', '... works as expected';
}

{
isa_ok 42.KeyBag, KeyBag, "Method .KeyBag works on Int-1";
is showkv(42.KeyBag), "42:1", "Method .KeyBag works on Int-2";
isa_ok "blue".KeyBag, KeyBag, "Method .KeyBag works on Str-1";
is showkv("blue".KeyBag), "blue:1", "Method .KeyBag works on Str-2";
isa_ok 42.BagHash, BagHash, "Method .BagHash works on Int-1";
is showkv(42.BagHash), "42:1", "Method .BagHash works on Int-2";
isa_ok "blue".BagHash, BagHash, "Method .BagHash works on Str-1";
is showkv("blue".BagHash), "blue:1", "Method .BagHash works on Str-2";
my @a = <Now the cross-handed set was the Paradise way>;
isa_ok @a.KeyBag, KeyBag, "Method .KeyBag works on Array-1";
is showkv(@a.KeyBag), "Now:1 Paradise:1 cross-handed:1 set:1 the:2 was:1 way:1", "Method .KeyBag works on Array-2";
isa_ok @a.BagHash, BagHash, "Method .BagHash works on Array-1";
is showkv(@a.BagHash), "Now:1 Paradise:1 cross-handed:1 set:1 the:2 was:1 way:1", "Method .BagHash works on Array-2";
my %x = "a" => 1, "b" => 2;
isa_ok %x.KeyBag, KeyBag, "Method .KeyBag works on Hash-1";
is showkv(%x.KeyBag), "a:1 b:2", "Method .KeyBag works on Hash-2";
isa_ok (@a, %x).KeyBag, KeyBag, "Method .KeyBag works on Parcel-1";
is showkv((@a, %x).KeyBag), "Now:1 Paradise:1 a:1 b:2 cross-handed:1 set:1 the:2 was:1 way:1",
"Method .KeyBag works on Parcel-2";
isa_ok %x.BagHash, BagHash, "Method .BagHash works on Hash-1";
is showkv(%x.BagHash), "a:1 b:2", "Method .BagHash works on Hash-2";
isa_ok (@a, %x).BagHash, BagHash, "Method .BagHash works on Parcel-1";
is showkv((@a, %x).BagHash), "Now:1 Paradise:1 a:1 b:2 cross-handed:1 set:1 the:2 was:1 way:1",
"Method .BagHash works on Parcel-2";
}

# vim: ft=perl6
14 changes: 7 additions & 7 deletions S02-types/declare.t
View file
Expand Up @@ -178,7 +178,7 @@ plan 78;

# junction StrPos StrLen uint Nil Whatever Mu Failure
# Exception Range Bag Signature Capture Blob Instant Duration
# Keyhash KeySet KeyBag Pair Mapping IO Routine Sub Method
# Keyhash SetHash BagHash Pair Mapping IO Routine Sub Method
# Submethod Macro Match Package Module Class Role Grammar Any

#?rakudo skip 'junction not implemented'
Expand Down Expand Up @@ -288,16 +288,16 @@ plan 78;
isa_ok($pamu,KeyHash );
}

#?pugs skip 'KeySet'
#?pugs skip 'SetHash'
{
my KeySet $paxa;
isa_ok($paxa,KeySet );
my SetHash $paxa;
isa_ok($paxa,SetHash );
}

#?pugs skip 'KeyBag'
#?pugs skip 'BagHash'
{
my KeyBag $paze;
isa_ok($paze,KeyBag );
my BagHash $paze;
isa_ok($paze,BagHash );
}

{
Expand Down

0 comments on commit 109ff98

Please sign in to comment.