t/001_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 69;
   7
   8 use Moose::Autobox;
   9
  10 my $VAR1; # for eval of dumps
  11
  12 # SCALAR & UNDEF
  13
  14 my $s;
  15 ok(!$s->defined, '... got a undefined value');
  16
  17 $s = 5;
  18 ok($s->defined, '... got a defined value');
  19
  20 eval $s->dump;
  21 is($VAR1, 5 , '... eval of SCALAR->dump works');
  22
  23 eval $s->flatten;
  24 is($VAR1, 5 , '... eval of SCALAR->flatten works');
  25
  26 eval $s->perl;
  27 is($s->perl, $s->dump, '... SCALAR->dump equals SCALAR->perl');
  28
  29 # CODE
  30
  31 my $f1 = sub { @_ };
  32 ok($f1->defined, '... created function');
  33
  34 my $f2 = eval { $f1->curry(1, 2, 3)  };
  35 ok($f2->defined, '... created curried function');
  36
  37 my $f3 = eval { $f1->rcurry(1, 2, 3) };
  38 ok($f3->defined, '... created right-curried function');
  39
  40 is_deeply(
  41 [ $f2->(4, 5, 6) ],
  42 [ 1, 2, 3, 4, 5, 6 ],
  43 '... got the right return value from the curried function');
  44
  45 is_deeply(
  46 [ $f3->(4, 5, 6) ],
  47 [ 4, 5, 6, 1, 2, 3 ],
  48 '... got the right return value from the r-curried function');
  49
  50 ok((sub { 1 })->disjoin(sub { 0 })->(), '... disjoins properly');
  51 ok((sub { 0 })->disjoin(sub { 1 })->(), '... disjoins properly');
  52
  53 ok(!(sub { 1 })->conjoin(sub { 0 })->(), '... conjoins properly');
  54 ok(!(sub { 0 })->conjoin(sub { 1 })->(), '... conjoins properly');
  55
  56 my $compose = (sub { @_, 1 })->compose(sub { @_, 2 });
  57
  58 is_deeply(
  59 [ $compose->() ],
  60 [ 1, 2 ],
  61 '... got the right return value for compose');
  62
  63 # ARRAY
  64
  65 my $a = [ 4, 2, 6, 78, 101, 2, 3 ];
  66
  67 is($a->length, 7, '... got the right length');
  68 ok($a->defined, '... got the right defined value');
  69
  70 is_deeply(
  71 $a->map(sub { $_ + 2 }),
  72 [ map { $_ + 2 } (4, 2, 6, 78, 101, 2, 3) ],
  73 '... got the right return value for map');
  74
  75 is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged');
  76
  77 my $b = [1, 2, 3];
  78 $b->map(sub { $_++ } );
  79 is_deeply($b, [ 2, 3, 4 ], '... original value is changed');
  80
  81 is_deeply(
  82 $a->reverse(),
  83 [ 3, 2, 101, 78, 6, 2, 4 ],
  84 '... got the right return value for reverse');
  85
  86 is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged');
  87
  88 is_deeply(
  89 $a->grep(sub { $_ < 50 }),
  90 [ grep { $_ < 50 } (4, 2, 6, 78, 101, 2, 3) ],
  91 '... got the right return value grep');
  92
  93 is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged');
  94
  95 is($a->join(', '), '4, 2, 6, 78, 101, 2, 3', '... got the right joined string');
  96 is($a->join, '4267810123', '... got the right joined string');
  97 ok($a->exists(0), '... exists works');
  98 ok(!$a->exists(10), '... exists works');
  99
 100 is($a->pop(), 3, '... got the right pop-ed value');
 101 is_deeply($a, [ 4, 2, 6, 78, 101, 2 ], '... original value is now changed');
 102
 103 is($a->shift(), 4, '... got the right unshift-ed value');
 104 is_deeply($a, [ 2, 6, 78, 101, 2 ], '... original value is now changed');
 105
 106
 107 is_deeply(
 108 $a->slice([ 1, 2, 4 ]),
 109 [ 6, 78, 2 ],
 110 '... got the right sliced value');
 111
 112 is_deeply(
 113 $a->unshift(10),
 114 [ 10, 2, 6, 78, 101, 2 ],
 115 '... got the correct unshifted value');
 116
 117 is_deeply(
 118 $a->unshift(15, 20, 30),
 119 [ 15, 20, 30, 10, 2, 6, 78, 101, 2 ],
 120 '... got the correct unshifted value (multiple values)');
 121
 122 is_deeply(
 123 $a->push(10),
 124 [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10 ],
 125 '... got the correct pushed value');
 126
 127 is_deeply(
 128 $a->push(15, 20, 30),
 129 [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ],
 130 '... got the correct pushed value (multiple values)');
 131
 132 is_deeply(
 133 $a->sort(sub { $_[0] <=> $_[1] }),
 134 [ 2, 2, 6, 10, 10, 15, 15, 20, 20, 30, 30, 78, 101 ],
 135 '... got the correct sorted value');
 136
 137 is_deeply(
 138 $a,
 139 [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ],
 140 '... the original values are unchanged');
 141
 142 is_deeply(
 143 []->push(10, 20, 30)->map(sub { ($_, $_ + 5) })->reverse,
 144 [ 35, 30, 25, 20, 15, 10 ],
 145 '... got the correct chained value');
 146
 147 is_deeply(
 148 $a->keys,
 149 [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 ],
 150 '... the keys');
 151
 152 is_deeply(
 153 $a->values,
 154 [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ],
 155 '... the values');
 156
 157 is_deeply(
 158 $a->kv,
 159 [ [0, 15], [1, 20], [2, 30], [3, 10], [4, 2], [5, 6], [6, 78],
 160   [7, 101], [8, 2], [9, 10], [10, 15], [11, 20], [12, 30] ],
 161 '... [ k, v ]');
 162
 163 is([1, 2, 3, 4, 5]->reduce(sub { $_[0] + $_[1] }), 15, '... got the right reduction');
 164
 165 is_deeply(
 166 [1, 2, 3, 4, 5]->zip([ 5, 4, 3, 2, 1 ]),
 167 [ [1, 5], [2, 4], [3, 3], [4, 2], [5, 1] ],
 168 '... got the right zip');
 169
 170 is_deeply(
 171 [1, 2, 3, 4, 5]->zip([ 6, 5, 4, 3, 2, 1 ]),
 172 [ [1, 6], [2, 5], [3, 4], [4, 3], [5, 2], [undef, 1] ],
 173 '... got the right zip');
 174
 175 is($a->delete(2), 30, '... got the value deleted');
 176 is_deeply(
 177 $a,
 178 [ 15, 20, undef, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ],
 179 '... the value is correctly deleted');
 180
 181 $a->put(2, 30);
 182
 183 is_deeply(
 184 $a,
 185 [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ],
 186 '... the value is correctly put');
 187
 188 eval($a->dump);
 189 is_deeply( $VAR1,
 190            [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ],
 191            '... the value is correctly dumped');
 192
 193 is( $a->dump,
 194     $a->perl,
 195     '... the value is correctly dumped with perl()' );
 196
 197 is([1, 2, 3, 4, 5]->any, 3, '... any correctly found a value');
 198 is([1, 1, 2, 3, 4, 5, 5]->one, 2, '... one correctly found one value');
 199 is([1, 1, 2, 3, 4, 5, 5]->none , 6, '... none correctly did not find any of a value');
 200 is([3, 3, 3]->all, 3, '... all correctly found all of a value');
 201
 202 # Hash
 203
 204 my $h = { one => 1, two => 2, three => 3 };
 205
 206 ok($h->defined, '... got the right defined value');
 207
 208 is_deeply(
 209 $h->keys->sort,
 210 [ qw/one three two/ ],
 211 '... the keys');
 212
 213 is_deeply(
 214 $h->values->sort,
 215 [ 1, 2, 3 ],
 216 '... the values');
 217
 218 is_deeply(
 219 $h->kv->sort(sub { $_[0]->[1] <=> $_[1]->[1] }),
 220 [ ['one', 1], ['two', 2], ['three', 3] ],
 221 '... the kvs');
 222
 223 ok($h->exists('two'), '... exists works');
 224 ok(!$h->exists('five'), '... !exists works');
 225
 226 $h->put('four' => 4);
 227 is_deeply(
 228 $h,
 229 { one => 1, two => 2, three => 3, four => 4 },
 230 '... got the value added correctly');
 231
 232 is($h->at('four'), 4, '... got the value at "four"');
 233
 234 $h->delete('four');
 235 is_deeply(
 236 $h,
 237 { one => 1, two => 2, three => 3 },
 238 '... got the value deleted correctly');
 239
 240 is_deeply(
 241 $h->merge({ three => 33, four => 44 }),
 242 { one => 1, two => 2, three => 33, four => 44 },
 243 '... got the hashes merged correctly');
 244
 245 eval($h->dump);
 246 is_deeply( $VAR1,
 247            { one => 1, two => 2, three => 3 },
 248            '... the value is correctly dumped');
 249
 250 is( $h->dump,
 251     $h->perl,
 252     '... the value is correctly dumped with perl()' );
 253
 254 is_deeply( { one => 1, two => 2, three => 3 }->slice([qw/three one/]),
 255            [ qw/3 1/ ],
 256            '... hash slices ok' );
 257
 258 is_deeply( { one => 1, two => 2, three => 3 }->hslice([qw/two three/]),
 259            { two => 2, three => 3 },
 260            '... hash hslices ok' );