Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 171 lines (134 sloc) 5.67 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
use v6;
use Test;

plan 59;

sub showkh($h) {
    $h.keys.sort.map({ $^k ~ ':' ~ $h{$k} }).join(' ')
}

# L<S02/Mutable types/"The QuantHash role differs from a normal Associative hash">

# untyped QuantHash
{
    my %h is QuantHash = a => 1, b => 3, c => -1, d => 7;
    is showkh(%h), 'a:1 b:3 c:-1 d:7', 'Inititalization worked';
    is %h.elems, 10, '.elems';
    is +%h, 10, 'prefix:<+> calls .elems, not .keys';

    lives_ok { %h<d> = 0 }, 'Can set an item to 0';
    is +%h.keys, 3, '... and an item is gone';
    is showkh(%h), 'a:1 b:3 c:-1', '... and the right one is gone';
    nok %h<d>:exists, '... also according to exists';

    %h<c>++;
    is showkh(%h), 'a:1 b:3', '++ on an item with -1 deletes it';
    %h<a>--;
    is showkh(%h), 'b:3', '-- also removes items when they go to zero';
    %h<b>--;
    is showkh(%h), 'b:2', '... but only when they go to zero';

    %h<c> = 'abc';
    is showkh(%h), 'b:2 c:abc', 'Can store a string as well';
    %h<c> = '';
    is +%h.keys, 1, 'Setting a value to the null string also removes it';

    %h<b> = Nil;
    is +%h.keys, 0, 'Setting a value to Nil also removes it';
    nok %h, 'An empty QuantHash is false';

    %h<foo bar baz> = "", 5, False;
    is showkh(%h), 'bar:5', 'Assignment to multiple keys';

    (%h<foo> = 0) = 7;
    is showkh(%h), 'bar:5 foo:7', '(%keyhash<foo> = 0) = 7';
    (%h<foo> = 15) = '';
    is showkh(%h), 'bar:5', '(%keyhash<foo> = 15) = \'\'';
}

{
    my %h is QuantHash = a => 5, b => 0, c => 1, d => '', e => Any;
    is showkh(%h), 'a:5 c:1', 'Pairs with false values are ignored in assignment';

    %h = foo => 1, bar => 2, foo => 1;
    is showkh(%h), 'bar:2 foo:1', "Duplicate keys aren't stored";

    %h = foo => 1, bar => 5, foo => 0,
         bar => '', bar => 3, baz => 0, baz => 'narwhal';
    is showkh(%h), 'bar:3 baz:narwhal', 'When pairs conflict, the last is preferred';

    %h = 'foo', 2, 'bar', 6, 'foo', 0,
         'bar', '', 'bar', 4, 'baz', 0, 'baz', 'unicorn';
    is showkh(%h), 'bar:4 baz:unicorn', 'Assignment of a flat list';
}

#?rakudo skip 'Non-string QuantHash keys NYI'
{
    my %h is QuantHash = 2 => 1, a => 2, (False) => 3;

    my @ks = %h.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 %h{2, 'a', False}.sort.join(' '), '1 2 3', 'All keys have the right values';
}

# QuantHash of Ints
{
    #?rakudo emit role R1284381704 does QuantHash[Int] {}; my %h is R1284381704; # 'my SomeType %h' NYI
    my Int %h is QuantHash;
    %h = a => 1, b => 3, c => -1, d => 7, e => 0;
    is +%h.keys, 4, 'Initializing QuantHash of Ints worked';

    is %h<camelia>, 0, 'Correct default value';
    is %h.elems, 10, '.elems';

    lives_ok { %h<d> = 0 }, 'Can set an item to 0';
    is +%h.keys, 3, '... and an item is gone';
    is showkh(%h), 'a:1 b:3 c:-1', '... and the right one is gone';

    %h<c>++;
    is showkh(%h), 'a:1 b:3', '++ on an item with -1 deletes it';

    %h<a>--;
    is showkh(%h), 'b:3', '-- also removes items when they go to zero';
    %h<b>--;
    is showkh(%h), 'b:2', '... but only when they go to zero';
}

# QuantHash of Strs
{
    #?rakudo emit role R1284382935 does QuantHash[Str] {}; my %h is R1284382935; # 'my SomeType %h' NYI
    my Str %h is QuantHash;
    %h = a => 'foo', b => 'bar', c => 'baz', d => 'boor', e => '';
    is +%h.keys, 4, 'Initializing QuantHash of Strs works';

    is %h<camelia>, '', 'Correct default value';

    lives_ok { %h<d> = '' }, 'Can set an item to the null string';
    is +%h.keys, 3, '... and an item is gone';
    is showkh(%h), 'a:foo b:bar c:baz', '... and the right one is gone';

    %h<c> ~~ s/baz//;
    is showkh(%h), 'a:foo b:bar', 'Changing a value to the null string deletes it';
    %h<b> ~~ s/bar/b/;
    is showkh(%h), 'a:foo b:b', '... but not changing it to a one-character string';
}

# QuantHash with a custom default value
{
    #?rakudo emit role R1284381677 does QuantHash[Any, 42] {}; my %h is R1284381677; # 'my %h is SomeType[WithParams]' NYI
    my %h is QuantHash[Any, 42];
    %h = a => 1, b => 2, c => 0, x1 => 42;
    is showkh(%h), 'a:1 b:2 c:0', 'Initializing a QuantHash with a custom default';

    is %h<answer>, 42, 'QuantHash with custom default returns the default for an unassigned key';
    is showkh(%h), 'a:1 b:2 c:0', '...without changing the QuantHash';

    %h<a> = '';
    is showkh(%h), 'a: b:2 c:0', "Setting a key to the empty string doesn't remove it";
    %h<a> = 42;
    is showkh(%h), 'b:2 c:0', 'But setting a key to the default does remove it';
}

# L<S32::Containers/QuantHash/"=item grab">

# Weighted .pick
{
    my %h is QuantHash = a => 1, b => 1, c => 1, d => 20;

    my @a = %h.pick: *;
    is +@a, 23, '.pick(*) returns the right number of items';
    is @a.grep(* eq 'a').elems, 1, '.pick (1)';
    is @a.grep(* eq 'b').elems, 1, '.pick (2)';
    is @a.grep(* eq 'c').elems, 1, '.pick (3)';
    is @a.grep(* eq 'd').elems, 20, '.pick (4)';
    isnt @a[^3].join, 'abc', '.pick (5)';
}

# Weighted .roll
{
    my %h is QuantHash = a => 1, b => 2;

    my @a = %h.roll: 100;
    is +@a, 100, '.roll(100) returns 100 items';
    ok 2 < @a.grep(* eq 'a') < 75, '.roll (1)';
    ok @a.grep(* eq 'a') + 2 < @a.grep(* eq 'b'), '.roll (2)';
}

# .grab
{
    my %h is QuantHash = a => 40, b => 80;

    my @a = %h.grab: 30;
    is +%h, 90, '.grab(30) removes 30 elements';
    is +@a, 30, '.grab(30) yields 30 items';
    ok 1 < @a.grep(* eq 'a') < 30, '.grab (1)';
    ok @a.grep(* eq 'a') < @a.grep(* eq 'b'), '.grab (2)';
}

# vim: ft=perl6
Something went wrong with that request. Please try again.