Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 257 lines (204 sloc) 8.763 kb
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
1 use v6;
2 use Test;
3
35ba0287 »
2012-03-27 Change Bag.Str and KeyBag.Str to conform to TimToady's suggestions:
4 plan 103;
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
5
6 sub showkv($x) {
7 $x.keys.sort.map({ $^k ~ ':' ~ $x{$^k} }).join(' ')
8 }
9
10 # L<S02/Immutable types/'the bag listop'>
11
12 {
13 my $b = bag <a foo a a a a b foo>;
14 isa_ok $b, Bag, '&bag produces a Bag';
15 is showkv($b), 'a:5 b:1 foo:2', '...with the right elements';
16
17 is $b<a>, 5, 'Single-key subscript (existing element)';
8d18a308 »
2012-02-09 70 more tests for Bag.
18 isa_ok $b<a>, Int, 'Single-key subscript yields an Int';
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
19 is $b<santa>, 0, 'Single-key subscript (nonexistent element)';
8d18a308 »
2012-02-09 70 more tests for Bag.
20 isa_ok $b<santa>, Int, 'Single-key subscript yields an Int (nonexistent element)';
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
21 ok $b.exists('a'), '.exists with existing element';
22 nok $b.exists('santa'), '.exists with nonexistent element';
23
8d18a308 »
2012-02-09 70 more tests for Bag.
24 is $b.values.elems, 3, "Values returns the correct number of values";
25 is ([+] $b.values), 8, "Values returns the correct sum";
26 ok ?$b, "Bool returns True if there is something in the Bag";
27 nok ?Bag.new(), "Bool returns False if there is nothing in the Bag";
28
29 my $hash;
30 lives_ok { $hash = $b.hash }, ".hash doesn't die";
31 isa_ok $hash, Hash, "...and it returned a Hash";
32 is showkv($hash), 'a:5 b:1 foo:2', '...with the right elements';
33
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
34 dies_ok { $b<a> = 5 }, "Can't assign to an element (Bags are immutable)";
8d18a308 »
2012-02-09 70 more tests for Bag.
35 dies_ok { $b<a>++ }, "Can't increment an element (Bags are immutable)";
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
36 dies_ok { $b.keys = <c d> }, "Can't assign to .keys";
37 dies_ok { $b.values = 3, 4 }, "Can't assign to .values";
38
8d18a308 »
2012-02-09 70 more tests for Bag.
39 is ~$b<a b>, "5 1", 'Multiple-element access';
40 is ~$b<a santa b easterbunny>, "5 0 1 0", 'Multiple-element access (with nonexistent elements)';
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
41
42 is $b.elems, 8, '.elems gives sum of values';
43 is +$b, 8, '+$bag gives sum of values';
44 }
45
71f1532c »
2012-03-01 Tune and fudge bag, keybag, keyset and set tests for Rakudo and for G…
46 #?rakudo skip ':exists and :delete NYI'
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
47 {
df27e0df »
2012-02-11 Add tests for Set et al :exists and :delete.
48 my $s = bag <a a b foo>;
49 is $s<a>:exists, True, ':exists with existing element';
50 is $s<santa>:exists, False, ':exists with nonexistent element';
51 dies_ok { $s<a>:delete }, ':delete does not work on bag';
52 }
53
54 {
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
55 my $b = bag 'a', False, 2, 'a', False, False;
56 my @ks = $b.keys;
f7052e6c »
2012-01-25 Fudge for niecza.
57 #?niecza 2 todo
71f1532c »
2012-03-01 Tune and fudge bag, keybag, keyset and set tests for Rakudo and for G…
58 #?rakudo 2 todo ''
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
59 is @ks.grep(Int)[0], 2, 'Int keys are left as Ints';
60 is @ks.grep(* eqv False).elems, 1, 'Bool keys are left as Bools';
61 is @ks.grep(Str)[0], 'a', 'And Str keys are permitted in the same set';
62 is $b{2, 'a', False}.sort.join(' '), '1 2 3', 'All keys have the right values';
63 }
64
f7052e6c »
2012-01-25 Fudge for niecza.
65 #?niecza skip "Unmatched key in Hash.LISTSTORE"
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
66 {
67 my %h = bag <a b o p a p o o>;
68 ok %h ~~ Hash, 'A hash to which a Bag has been assigned remains a hash';
69 is showkv(%h), 'a:2 b:1 o:3 p:2', '...with the right elements';
70 }
71
72 {
8d18a308 »
2012-02-09 70 more tests for Bag.
73 my $b = bag <a b o p a p o o>;
74 isa_ok $b, Bag, '&Bag.new given an array of strings produces a Bag';
75 is showkv($b), 'a:2 b:1 o:3 p:2', '...with the right elements';
76 }
77
78 {
49f02a26 »
2012-02-18 Make sure zero-valued pairs are properly ignored in the constructors.
79 my $b = bag [ foo => 10, bar => 17, baz => 42, santa => 0 ];
8d18a308 »
2012-02-09 70 more tests for Bag.
80 isa_ok $b, Bag, '&Bag.new given an array of pairs produces a Bag';
81 is showkv($b), 'bar:17 baz:42 foo:10', '... with the right elements';
82 }
83
84 {
49f02a26 »
2012-02-18 Make sure zero-valued pairs are properly ignored in the constructors.
85 my $b = bag { foo => 10, bar => 17, baz => 42, santa => 0 }.hash;
8d18a308 »
2012-02-09 70 more tests for Bag.
86 isa_ok $b, Bag, '&Bag.new given a Hash produces a Bag';
87 is showkv($b), 'bar:17 baz:42 foo:10', '... with the right elements';
88 }
89
90 {
49f02a26 »
2012-02-18 Make sure zero-valued pairs are properly ignored in the constructors.
91 my $b = bag { foo => 10, bar => 17, baz => 42, santa => 0 };
8d18a308 »
2012-02-09 70 more tests for Bag.
92 isa_ok $b, Bag, '&Bag.new given a Hash produces a Bag';
93 is showkv($b), 'bar:17 baz:42 foo:10', '... with the right elements';
94 }
95
96 {
97 my $b = bag set <foo bar foo bar baz foo>;
98 isa_ok $b, Bag, '&Bag.new given a Set produces a Bag';
99 is showkv($b), 'bar:1 baz:1 foo:1', '... with the right elements';
100 }
101
102 {
103 my $b = bag KeySet.new(set <foo bar foo bar baz foo>);
104 isa_ok $b, Bag, '&Bag.new given a KeySet produces a Bag';
105 is showkv($b), 'bar:1 baz:1 foo:1', '... with the right elements';
106 }
107
108 {
109 my $b = bag KeyBag.new(set <foo bar foo bar baz foo>);
110 isa_ok $b, Bag, '&Bag.new given a KeyBag produces a Bag';
111 is showkv($b), 'bar:1 baz:1 foo:1', '... with the right elements';
112 }
113
114 {
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
115 my $b = bag set <foo bar foo bar baz foo>;
116 isa_ok $b, Bag, '&bag given a Set produces a Bag';
117 is showkv($b), 'bar:1 baz:1 foo:1', '... with the right elements';
118 }
119
120 # L<S02/Names and Variables/'C<%x> may be bound to'>
121
122 {
123 my %b := bag <a b c b>;
124 isa_ok %b, Bag, 'A Bag bound to a %var is a Bag';
125 is showkv(%b), 'a:1 b:2 c:1', '...with the right elements';
126
127 is %b<b>, 2, 'Single-key subscript (existing element)';
128 is %b<santa>, 0, 'Single-key subscript (nonexistent element)';
129
130 dies_ok { %b<a> = 1 }, "Can't assign to an element (Bags are immutable)";
131 dies_ok { %b = bag <a b> }, "Can't assign to a %var implemented by Bag";
132 }
133
8d18a308 »
2012-02-09 70 more tests for Bag.
134 {
135 my $b = bag { foo => 10, bar => 1, baz => 2};
136
137 # .list is just the keys, as per TimToady:
138 # http://irclog.perlgeek.de/perl6/2012-02-07#i_5112706
139 isa_ok $b.list.elems, 3, ".list returns 3 things";
140 is $b.list.grep(Str).elems, 3, "... all of which are Str";
141
142 isa_ok $b.pairs.elems, 3, ".pairs returns 3 things";
143 is $b.pairs.grep(Pair).elems, 3, "... all of which are Pairs";
144 is $b.pairs.grep({ .key ~~ Str }).elems, 3, "... the keys of which are Strs";
145 is $b.pairs.grep({ .value ~~ Int }).elems, 3, "... and the values of which are Ints";
146
147 is $b.iterator.grep(Pair).elems, 3, ".iterator yields three Pairs";
148 is $b.iterator.grep({ .key ~~ Str }).elems, 3, "... the keys of which are Strs";
149 is $b.iterator.grep({True}).elems, 3, "... and nothing else";
150 }
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
151
152 {
8d18a308 »
2012-02-09 70 more tests for Bag.
153 my $b = bag { foo => 10000000000, bar => 17, baz => 42 };
154 my $s;
155 my $c;
156 lives_ok { $s = $b.perl }, ".perl lives";
157 isa_ok $s, Str, "... and produces a string";
158 ok $s.chars < 1000, "... of reasonable length";
159 lives_ok { $c = eval $s }, ".perl.eval lives";
160 isa_ok $c, Bag, "... and produces a Bag";
161 is showkv($c), showkv($b), "... and it has the correct values";
162 }
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
163
8d18a308 »
2012-02-09 70 more tests for Bag.
164 {
35ba0287 »
2012-03-27 Change Bag.Str and KeyBag.Str to conform to TimToady's suggestions:
165 my $b = bag { foo => 2, bar => 3, baz => 1 };
8d18a308 »
2012-02-09 70 more tests for Bag.
166 my $s;
167 lives_ok { $s = $b.Str }, ".Str lives";
168 isa_ok $s, Str, "... and produces a string";
5d0290d4 »
2012-04-02 rakudo refudges
169 #?rakudo todo 'Bag stringification'
35ba0287 »
2012-03-27 Change Bag.Str and KeyBag.Str to conform to TimToady's suggestions:
170 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";
8d18a308 »
2012-02-09 70 more tests for Bag.
171 }
172
173 {
174 my $b = bag { foo => 10000000000, bar => 17, baz => 42 };
175 my $s;
176 lives_ok { $s = $b.gist }, ".gist lives";
177 isa_ok $s, Str, "... and produces a string";
178 ok $s.chars < 1000, "... of reasonable length";
179 ok $s ~~ /foo/, "... which mentions foo";
180 ok $s ~~ /bar/, "... which mentions bar";
181 ok $s ~~ /baz/, "... which mentions baz";
182 }
183
184 # L<S02/Names and Variables/'C<%x> may be bound to'>
185
186 {
187 my %b := bag "a", "b", "c", "b";
188 isa_ok %b, Bag, 'A Bag bound to a %var is a Bag';
189 is showkv(%b), 'a:1 b:2 c:1', '...with the right elements';
190
191 is %b<b>, 2, 'Single-key subscript (existing element)';
192 is %b<santa>, 0, 'Single-key subscript (nonexistent element)';
ea8f32d7 »
2010-09-15 [bag.t] Use .roll instead of .pick with :replace.
193 }
194
195 # L<S32::Containers/Bag/roll>
196
197 {
8d18a308 »
2012-02-09 70 more tests for Bag.
198 my $b = Bag.new("a", "b", "b");
199
200 my $a = $b.roll;
201 ok $a eq "a" || $a eq "b", "We got one of the two choices";
202
203 my @a = $b.roll(2);
204 is +@a, 2, '.roll(2) returns the right number of items';
205 is @a.grep(* eq 'a').elems + @a.grep(* eq 'b').elems, 2, '.roll(2) returned "a"s and "b"s';
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
206
71f1532c »
2012-03-01 Tune and fudge bag, keybag, keyset and set tests for Rakudo and for G…
207 @a = $b.roll: 100;
ea0bb443 »
2010-09-15 Revamped keyhash.t.
208 is +@a, 100, '.roll(100) returns 100 items';
ea8f32d7 »
2010-09-15 [bag.t] Use .roll instead of .pick with :replace.
209 ok 2 < @a.grep(* eq 'a') < 75, '.roll(100) (1)';
210 ok @a.grep(* eq 'a') + 2 < @a.grep(* eq 'b'), '.roll(100) (2)';
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
211 }
212
8d18a308 »
2012-02-09 70 more tests for Bag.
213 {
214 my $b = Bag.new({"a" => 100000000000, "b" => 1});
215
216 my $a = $b.roll;
217 ok $a eq "a" || $a eq "b", "We got one of the two choices (and this was pretty quick, we hope!)";
218
219 my @a = $b.roll: 100;
220 is +@a, 100, '.roll(100) returns 100 items';
221 ok @a.grep(* eq 'a') > 97, '.roll(100) (1)';
222 ok @a.grep(* eq 'b') < 3, '.roll(100) (2)';
223 }
224
225 # L<S32::Containers/Bag/pick>
226
227 {
228 my $b = Bag.new("a", "b", "b");
229
230 my $a = $b.pick;
231 ok $a eq "a" || $a eq "b", "We got one of the two choices";
232
233 my @a = $b.pick(2);
234 is +@a, 2, '.pick(2) returns the right number of items';
235 ok @a.grep(* eq 'a').elems <= 1, '.pick(2) returned at most one "a"';
236 is @a.grep(* eq 'b').elems, 2 - @a.grep(* eq 'a').elems, '.pick(2) and the rest are "b"';
237
238 @a = $b.pick: *;
239 is +@a, 3, '.pick(*) returns the right number of items';
240 is @a.grep(* eq 'a').elems, 1, '.pick(*) (1)';
241 is @a.grep(* eq 'b').elems, 2, '.pick(*) (2)';
242 }
243
244 {
245 my $b = Bag.new({"a" => 100000000000, "b" => 1});
246
247 my $a = $b.pick;
248 ok $a eq "a" || $a eq "b", "We got one of the two choices (and this was pretty quick, we hope!)";
249
250 my @a = $b.pick: 100;
251 is +@a, 100, '.pick(100) returns 100 items';
252 ok @a.grep(* eq 'a') > 98, '.pick(100) (1)';
253 ok @a.grep(* eq 'b') < 2, '.pick(100) (2)';
254 }
255
8e4955e6 »
2010-09-15 Added tests for Sets and Bags.
256 # vim: ft=perl6
Something went wrong with that request. Please try again.