X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F31-array.t;h=9f49f2e2863b670b45fa64d205b964503038501c;hb=a86e3e47a167afadf7de1231d6401a1139330ad0;hp=bb2f96e402b5101e61e627c2739229709fa7ae72;hpb=14f66d40970bef63105be046a109c1a32859a8a0;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/31-array.t b/t/31-array.t index bb2f96e..9f49f2e 100644 --- a/t/31-array.t +++ b/t/31-array.t @@ -5,99 +5,107 @@ use warnings; use Test::More tests => 21; -use Variable::Magic qw/wizard cast dispell/; +use Variable::Magic qw/wizard cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR/; -my @c = (0) x 5; -my @x = (0) x 5; +my @c = (0) x 12; +my @x = (0) x 12; sub check { - for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; } - return 1; + is join(':', map { (defined) ? $_ : 'u' } @c[0 .. 11]), + join(':', map { (defined) ? $_ : 'u' } @x[0 .. 11]), + $_[0]; } my $wiz = wizard get => sub { ++$c[0] }, set => sub { ++$c[1] }, len => sub { ++$c[2]; $_[2] }, clear => sub { ++$c[3] }, - free => sub { ++$c[4] }; -ok(check(), 'array : create wizard'); + free => sub { ++$c[4] }, + copy => sub { ++$c[5] }, + dup => sub { ++$c[6] }, + local => sub { ++$c[7] }, + fetch => sub { ++$c[8] }, + store => sub { ++$c[9] }, + 'exists' => sub { ++$c[10] }, + 'delete' => sub { ++$c[11] }; +check('array : create wizard'); my @n = map { int rand 1000 } 1 .. 5; my @a = @n; cast @a, $wiz; -ok(check(), 'array : cast'); +check('array : cast'); my $b = $a[2]; -ok(check(), 'array : assign element to'); +check('array : assign element to'); my @b = @a; ++$x[2]; -ok(check(), 'array : assign to'); +check('array : assign to'); $b = "X@{a}Y"; ++$x[2]; -ok(check(), 'array : interpolate'); +check('array : interpolate'); $b = \@a; -ok(check(), 'array : reference'); +check('array : reference'); @b = @a[2 .. 4]; -ok(check(), 'array : slice'); +check('array : slice'); @a = qw/a b d/; $x[1] += 3; ++$x[3]; -ok(check(), 'array : assign'); +check('array : assign'); $a[2] = 'c'; -ok(check(), 'array : assign old element'); +check('array : assign old element'); $a[3] = 'd'; ++$x[1]; -ok(check(), 'array : assign new element'); +check('array : assign new element'); push @a, 'x'; -++$x[1]; ++$x[2] unless $^V && $^V gt 5.9.2; # since 5.9.3 -ok(check(), 'array : push'); +++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_PUSH_NOLEN; +check('array : push'); pop @a; ++$x[1]; ++$x[2]; -ok(check(), 'array : pop'); +check('array : pop'); unshift @a, 'x'; ++$x[1]; ++$x[2]; -ok(check(), 'array : unshift'); +check('array : unshift'); shift @a; ++$x[1]; ++$x[2]; -ok(check(), 'array : shift'); +check('array : shift'); $b = @a; ++$x[2]; -ok(check(), 'array : length'); +check('array : length'); @a = map ord, @a; $x[1] += 4; ++$x[2]; ++$x[3]; -ok(check(), 'array : map'); +check('array : map'); @b = grep { defined && $_ >= ord('b') } @a; ++$x[2]; -ok(check(), 'array : grep'); +check('array : grep'); for (@a) { } $x[2] += 5; -ok(check(), 'array : for'); +check('array : for'); { my @b = @n; cast @b, $wiz; } ++$x[4]; -ok(check(), 'array : scope end'); +check('array : scope end'); undef @a; -++$x[3] if $^V && $^V gt 5.9.4; # since 5.9.5 - see #43357 -ok(check(), 'array : undef'); +++$x[3] if VMG_COMPAT_ARRAY_UNDEF_CLEAR; +check('array : undef'); dispell @a, $wiz; -ok(check(), 'array : dispel'); +check('array : dispel');