From: Vincent Pit Date: Thu, 27 Nov 2008 23:03:07 +0000 (+0100) Subject: Introduce VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID to cover unshift no longer calling... X-Git-Tag: v0.26~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=036e59a9c5fdf052edd1f603caa6838cc1825663;p=perl%2Fmodules%2FVariable-Magic.git Introduce VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID to cover unshift no longer calling len magic in void context (since 34908) --- diff --git a/Magic.xs b/Magic.xs index 3df5970..b486760 100644 --- a/Magic.xs +++ b/Magic.xs @@ -127,6 +127,13 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { # define VMG_COMPAT_ARRAY_PUSH_NOLEN 0 #endif +/* Applied to dev-5.11 as 34908 */ +#if VMG_HAS_PERL_MAINT(5, 11, 0, 34908) +# define VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID 1 +#else +# define VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID 0 +#endif + /* Applied to dev-5.9 as 31473 (see #43357), integrated to maint-5.8 as 32542 */ #if VMG_HAS_PERL_MAINT(5, 8, 9, 32542) || VMG_HAS_PERL_MAINT(5, 9, 5, 31473) || VMG_HAS_PERL(5, 10, 0) # define VMG_COMPAT_ARRAY_UNDEF_CLEAR 1 @@ -868,6 +875,8 @@ BOOT: newCONSTSUB(stash, "VMG_UVAR", newSVuv(VMG_UVAR)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN", newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN)); + newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID", + newSVuv(VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNDEF_CLEAR", newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR)); newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN", diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index 46e7ac3..59cf299 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -195,6 +195,8 @@ B<5.11.x> I : 'len' magic is no longer invoked when calling C with a magical scalar. +I : 'len' magic is no longer called when pushing / unshifting an element into a magical array in void context. The C part was already covered by I. + =back =head1 CONSTANTS @@ -231,6 +233,10 @@ When this constant is true, you can use the C callbac True for perls that don't call 'len' magic when you push an element in a magical array. +=head2 C + +True for perls that don't call 'len' magic when you unshift in void context an element in a magical array. + =head2 C True for perls that call 'clear' magic when undefining magical arrays. @@ -377,7 +383,7 @@ our @EXPORT = (); our %EXPORT_TAGS = ( 'funcs' => [ qw/wizard gensig getsig cast getdata dispell/ ], 'consts' => [ qw/SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/, - qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR/, + qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR/, qw/VMG_COMPAT_SCALAR_LENGTH_NOLEN/, qw/VMG_PERL_PATCHLEVEL/, qw/VMG_THREADSAFE/ ] diff --git a/t/01-import.t b/t/01-import.t index 05f7e9b..1b9f066 100644 --- a/t/01-import.t +++ b/t/01-import.t @@ -3,11 +3,11 @@ use strict; use warnings; -use Test::More tests => 18; +use Test::More tests => 19; require Variable::Magic; -for (qw/wizard gensig getsig cast getdata dispell SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR VMG_COMPAT_SCALAR_LENGTH_NOLEN VMG_PERL_PATCHLEVEL VMG_THREADSAFE/) { +for (qw/wizard gensig getsig cast getdata dispell SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR VMG_COMPAT_SCALAR_LENGTH_NOLEN VMG_PERL_PATCHLEVEL VMG_THREADSAFE/) { eval { Variable::Magic->import($_) }; is($@, '', 'import ' . $_); } diff --git a/t/31-array.t b/t/31-array.t index 9f49f2e..bc942c7 100644 --- a/t/31-array.t +++ b/t/31-array.t @@ -3,9 +3,9 @@ use strict; use warnings; -use Test::More tests => 21; +use Test::More tests => 24; -use Variable::Magic qw/wizard cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNDEF_CLEAR/; +use Variable::Magic qw/wizard cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR/; my @c = (0) x 12; my @x = (0) x 12; @@ -66,15 +66,23 @@ check('array : assign new element'); push @a, 'x'; ++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_PUSH_NOLEN; -check('array : push'); +check('array : push (void)'); + +$b = push @a, 'x'; +++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_PUSH_NOLEN; +check('array : push (scalar)'); pop @a; ++$x[1]; ++$x[2]; check('array : pop'); unshift @a, 'x'; +++$x[1]; ++$x[2] unless VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID; +check('array : unshift (void)'); + +$b = unshift @a, 'x'; ++$x[1]; ++$x[2]; -check('array : unshift'); +check('array : unshift (scalar)'); shift @a; ++$x[1]; ++$x[2]; @@ -82,10 +90,14 @@ check('array : shift'); $b = @a; ++$x[2]; -check('array : length'); +check('array : length @'); + +$b = $#a; +++$x[2]; +check('array : length $#'); @a = map ord, @a; -$x[1] += 4; ++$x[2]; ++$x[3]; +$x[1] += 6; ++$x[2]; ++$x[3]; check('array : map'); @b = grep { defined && $_ >= ord('b') } @a; @@ -93,7 +105,7 @@ check('array : map'); check('array : grep'); for (@a) { } -$x[2] += 5; +$x[2] += 7; check('array : for'); {