t/001_basic.t

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