Replaced Array::new with [ ]
[kakapo:kakapo.git] / t / Pmc / Array.nqp
1 #! parrot-nqp
2 # Copyright 2009-2010, Austin Hastings. See accompanying LICENSE file, or 
3 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.
4
5 INIT {
6         # Load the Kakapo library
7         pir::load_language('parrot');
8         my $env := pir::new__PS('Env');
9         my $root_dir := $env<HARNESS_ROOT_DIR> || '.';
10         pir::load_bytecode($root_dir ~ '/library/kakapo_full.pbc');
11 }
12
13 class Test::Program
14         is UnitTest::Testcase ;
15
16 INIT {
17         use(    'UnitTest::Testcase' ); 
18         use(    'UnitTest::Assertions' );       
19 }
20
21 MAIN();
22
23 sub MAIN() {    
24         my $proto := Opcode::get_root_global(pir::get_namespace__P().get_name);
25         $proto.suite.run;
26 }
27
28 method test_elems() {
29         my @a1;
30         
31         fail_unless( @a1.elems == 0,
32                 'New = empty = 0 elements');
33                 
34         @a1.push(1);
35         fail_unless( @a1.elems == 1,
36                 'One element test');
37 }
38
39 method test_set_size() {
40         
41         my @a1 := (1, 2, 3);
42         
43         fail_unless( @a1.elems == 3,
44                 'Size should be 3');
45                 
46         @a1.set_size(0);
47         fail_unless( @a1.elems == 0,
48                 'New size should be 0');
49                 
50         try {
51                 my $x := @a1.shift;
52                 fail( '0 element array should die on shift' );
53                 
54                 CATCH {}
55         };
56 }
57
58 method test_grep() {
59         my @a1 := grep( -> $x { $x > 3 }, 1, 2, 3, 4, 5 ,6, 7, 8, 9);
60         fail_unless( @a1.elems == 6,
61                 'Grep should remove first 3 elements');
62                 
63         my @a2 := @a1.grep: -> $n { $n % 2; };
64         fail_unless( @a2.elems == 3,
65                 'Grep odd should have 3 elements');
66 }
67
68 method test_map() {
69         
70         my @a1 := map( -> $x { $x * 2; }, 1, 2, 3, 4);
71         fail_unless( @a1.elems == 4,
72                 'Map should return similar list');
73         fail_unless( @a1[0] == 2 && @a1[3] == 8,
74                 'Map should double items in list');
75                 
76         my @a2 := <a b c>;
77         my @a3 := @a2.map: -> $w { $w ~ '_foo'; };
78         fail_unless( @a3.elems == 3,
79                 'Map should return similar list');
80         fail_unless( @a3.join eq 'a_foob_fooc_foo',
81                 'Map should append _foo');
82 }       
83
84 method test_new() {
85         my @a1;
86         
87         fail_unless( @a1.isa('ResizablePMCArray'),
88                 'Local array vivification should return RPA');
89                 
90         @a1 := ResizablePMCArray.new();
91         fail_unless( @a1.isa('ResizablePMCArray'),
92                 'RPA.new should return RPA');
93                 
94         @a1 := ResizableStringArray.new();
95         fail_unless( @a1.isa('ResizableStringArray'),
96                 'RSA.new should return RSA');
97                 
98         @a1 := [ 1, 2, 3, 4 ];
99         fail_unless( @a1.elems == 4,
100                 'New should create an array from its args');
101 }
102
103 method test_reduce() {
104         my &min := -> $a, $b { $a > $b ?? $b !! $a };
105         my &max := -> $a, $b { $a <  $b ?? $b !! $a };
106         
107         my $x := reduce(&min, 10, 9, 4, 100, 3, 11, 22, 1, 15, 9);
108         my $y := reduce(&max, 10, 9, 4, 100, 3, 11, 22, 1, 15, 9);
109         
110         fail_unless( $x == 1,
111                 'Min should reduce to 1');
112         fail_unless( $y == 100,
113                 'Max should reduce to 100');
114                 
115         my @a1 := <a b c d e f>;
116         
117         my $cat := @a1.reduce: -> $l, $r { "$l$r" };
118         fail_unless( $cat eq 'abcdef',
119                 'Cat should reduce to join');   
120 }
121
122 method test_reverse() {
123         my @a1 := <A B C D E F>;
124         
125         my $s := @a1.reverse.join('|');
126         fail_unless( $s eq 'F|E|D|C|B|A',
127                 'Reverse even array should be fedcba');
128         
129         @a1 := <L M N O P Q R>;
130         $s := @a1.reverse.join;
131         fail_unless( $s eq 'RQPONML',
132                 'Reverse odd array should be rqponml');
133         
134         @a1 := <X Y>;
135         $s := @a1.reverse.join;
136         fail_unless( $s eq 'YX',
137                 'Reverse short even should by yx');
138         
139         @a1 := <N N>;
140         @a1.pop;
141         $s := @a1.reverse.join;
142         fail_unless( $s eq 'N',
143                 'Reverse singleton array should be n');
144         
145         @a1 := <z z>;
146         @a1.pop;
147         @a1.pop;
148         $s := @a1.reverse.join;
149         fail_unless( $s eq '',
150                 'Reverse empty array is empty');
151 }
152
153 method test_slice() {
154         my @a1 := (1, 2, 3, 4, 5);
155         
156         my $s := @a1.slice(:to(2)).join;
157         fail_unless( $s eq '12',
158                 'Slice up to [2] should be 12' );
159         
160         $s := @a1.slice(:from(1)).join;
161         fail_unless( $s eq '2345',
162                 'Slice from [1] should be 2345');
163         
164         $s := @a1.slice(:from(-3), :to(-1)).join;
165         fail_unless( $s eq '34',
166                 'Slice from [-3 .. -1] should be 34');
167 }
168
169 method test_splice() {
170         my @a1 := (1, 2, 3, 4, 5);
171         my @a2 := <A B C D E>;
172         
173         my $s := @a1.clone.splice(@a2.clone, :replacing(5)).join;
174         fail_unless( $s eq 'ABCDE', 
175                 'Unset origin, replacing all should be ABCDE');
176
177         $s := @a1.clone.splice(@a2.clone, :from(5)).join;
178         fail_unless( $s eq '12345ABCDE', 
179                 'Splice at end appends');
180         
181         $s := @a1.clone.splice(@a2.clone, :from(4), :replacing(1)).join;
182         fail_unless( $s eq '1234ABCDE',
183                 'Replacing 1 at end');
184         
185         $s := @a1.clone.splice(@a2.clone, :replacing(2)).join;
186         fail_unless( $s eq 'ABCDE345',
187                 'Replacing first 2 elements');
188 }
189
190 method test_unsort() {
191         my @array := [ 'a', 'b', 'c', 'd' ];
192         my @yaarr := @array.clone.unsort;
193
194         fail_unless(@yaarr.elems == @array.elems,
195                 'Should have the same # elements');
196
197         my $same := 0;
198         
199         my $index := 0;
200         while $index < @array.elems {
201                 $same++
202                         if @array[$index] eq @yaarr[$index];
203                 $index++;
204         }
205         
206         fail_if($same == 4,
207                 'Result should not be the same array (unlikely, not impossible!)');
208                 
209 }
210
211 method test_zip() {
212         my @a1 := (1, 2, 3);
213         my @a2 := <a b c>;
214         
215         assert_equal( zip(@a1, @a2).join, '1a2b3c',
216                 'Zip should interweave the values');
217 }