]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/22-len.t
More tests for t/31-array.t
[perl/modules/Variable-Magic.git] / t / 22-len.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 13;
7
8 use Variable::Magic qw/wizard cast VMG_COMPAT_SCALAR_LENGTH_NOLEN/;
9
10 my $c = 0;
11
12 my $n = 1 + int rand 1000;
13 my $wiz = wizard len => sub { ++$c; return $n };
14 is $c, 0, 'len: wizard() doesn\'t trigger magic';
15
16 my @a = qw/a b c/;
17
18 $c = 0;
19 cast @a, $wiz;
20 is $c, 0, 'len: cast on array doesn\'t trigger magic';
21
22 $c = 0;
23 my $b = scalar @a;
24 is $c, 1,  'len: get array length triggers magic correctly';
25 is $b, $n, 'len: get array length correctly';
26
27 $c = 0;
28 $b = $#a;
29 is $c, 1,      'len: get last array index triggers magic correctly';
30 is $b, $n - 1, 'len: get last array index correctly';
31
32 $n = 0;
33
34 $c = 0;
35 $b = scalar @a;
36 is $c, 1, 'len: get array length 0 triggers magic correctly';
37 is $b, 0, 'len: get array length 0 correctly';
38
39 SKIP: {
40  skip 'length() no longer calls mg_len magic' => 5 if VMG_COMPAT_SCALAR_LENGTH_NOLEN;
41
42  $c = 0;
43  $n = 1 + int rand 1000;
44  # length magic on scalars needs also get magic to be triggered.
45  $wiz = wizard get => sub { return 'anything' },
46                len => sub { ++$c; return $n };
47
48  my $x = int rand 1000;
49
50  $c = 0;
51  cast $x, $wiz;
52  is $c, 0, 'len: cast on scalar doesn\'t trigger magic';
53
54  $c = 0;
55  $b = length $x;
56  is $c, 1,  'len: get scalar length triggers magic correctly';
57  is $b, $n, 'len: get scalar length correctly';
58
59  $n = 0;
60
61  $c = 0;
62  $b = length $x;
63  is $c, 1,  'len: get scalar length 0 triggers magic correctly';
64  is $b, $n, 'len: get scalar length 0 correctly';
65 }