From: Vincent Pit Date: Mon, 5 Nov 2012 02:11:20 +0000 (-0200) Subject: Add VMG_COMPAT_SCALAR_NOLEN X-Git-Tag: rt80388^0 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=a924275b5f3d7c1c612add18c8bf7a6f358e703f Add VMG_COMPAT_SCALAR_NOLEN Starting from perl 5.17.4, perl no longer calls 'len' magic on scalars. This new compatibility macro reflects this change. This fixes RT #80388. --- diff --git a/Magic.xs b/Magic.xs index 9bdcca5..c199f7e 100644 --- a/Magic.xs +++ b/Magic.xs @@ -139,6 +139,12 @@ # define VMG_COMPAT_SCALAR_LENGTH_NOLEN 0 #endif +#if VMG_HAS_PERL(5, 17, 4) +# define VMG_COMPAT_SCALAR_NOLEN 1 +#else +# define VMG_COMPAT_SCALAR_NOLEN 0 +#endif + /* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160, partially * reverted to dev-5.11 as 9cdcb38b */ #if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0) @@ -1799,6 +1805,8 @@ BOOT: newCONSTSUB(stash, "VMG_UVAR", newSVuv(VMG_UVAR)); newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN", newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN)); + newCONSTSUB(stash, "VMG_COMPAT_SCALAR_NOLEN", + newSVuv(VMG_COMPAT_SCALAR_NOLEN)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN", newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID", diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index 2fe47c9..47ed91a 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -127,10 +127,13 @@ It is called for array subscripts and slices, but never for hashes. I -This magic only applies to scalars and arrays, and is triggered when the 'size' or the 'length' of the variable has to be known by Perl. +This magic only applies to arrays (though it used to also apply to scalars), and is triggered when the 'size' or the 'length' of the variable has to be known by Perl. This is typically the magic involved when an array is evaluated in scalar context, but also on array assignment and loops (C, C or C). The length is returned from the callback as an integer. +Starting from perl 5.12, this magic is no longer called by the C keyword, and starting from perl 5.17.4 it is also no longer called for scalars in any situation, making this magic only meaningful on arrays. +You can use the constants L and L to see if this magic is available for scalars or not. + =item * I @@ -434,6 +437,11 @@ Initial L capability was introduced in perl 5.9.5, with a fully funct True for perls that don't call I magic when taking the C of a magical scalar. +=head2 C + +True for perls that don't call I magic on scalars. +Implies L. + =head2 C True for perls that don't call I magic when you push an element in a magical array. @@ -633,6 +641,7 @@ our %EXPORT_TAGS = ( 'consts' => [ qw< MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR VMG_COMPAT_SCALAR_LENGTH_NOLEN + VMG_COMPAT_SCALAR_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR diff --git a/t/01-import.t b/t/01-import.t index 17fdc46..f6d41d0 100644 --- a/t/01-import.t +++ b/t/01-import.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 2 * 20; +use Test::More tests => 2 * 21; require Variable::Magic; @@ -15,6 +15,7 @@ my %syms = ( map { $_ => '' } qw< MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR VMG_COMPAT_SCALAR_LENGTH_NOLEN + VMG_COMPAT_SCALAR_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR diff --git a/t/22-len.t b/t/22-len.t index ab19730..6f556e6 100644 --- a/t/22-len.t +++ b/t/22-len.t @@ -5,7 +5,10 @@ use warnings; use Test::More tests => 39 + (2 * 2 + 1) + (5 + 2 * 3); -use Variable::Magic qw; +use Variable::Magic qw< + wizard cast dispell + VMG_COMPAT_SCALAR_LENGTH_NOLEN VMG_COMPAT_SCALAR_NOLEN +>; use lib 't/lib'; use Variable::Magic::TestValue; @@ -65,95 +68,101 @@ is $d, 0, 'len: get last empty array index have correct default length'; is $b, -1, 'len: get last empty array index correctly'; SKIP: { - skip 'length() no longer calls mg_len magic' => 16 if VMG_COMPAT_SCALAR_LENGTH_NOLEN; - - $c = 0; - $n = 1 + int rand 1000; - # length magic on scalars needs also get magic to be triggered. - my $wiz = wizard get => sub { return 'anything' }, - len => sub { $d = $_[2]; ++$c; return $n }; - - my $x = 6789; - - $c = 0; - cast $x, $wiz; - is $c, 0, 'len: cast on scalar doesn\'t trigger magic'; - - $c = 0; - $d = undef; - $b = length $x; - is $c, 1, 'len: get scalar length triggers magic correctly'; - is $d, 4, 'len: get scalar length have correct default length'; - is $b, $n, 'len: get scalar length correctly'; - - $n = 0; - - $c = 0; - $d = undef; - $b = length $x; - is $c, 1, 'len: get scalar length 0 triggers magic correctly'; - is $d, 4, 'len: get scalar length 0 have correct default length'; - is $b, $n, 'len: get scalar length 0 correctly'; - - $n = undef; - $x = ''; - cast $x, $wiz; - - $c = 0; - $d = undef; - $b = length $x; - is $c, 1, 'len: get empty scalar length triggers magic correctly'; - is $d, 0, 'len: get empty scalar length have correct default length'; - is $b, 0, 'len: get empty scalar length correctly'; - - $x = "\x{20AB}ongs"; - cast $x, $wiz; + skip 'len magic is no longer called for scalars' => 16 + 6 + if VMG_COMPAT_SCALAR_NOLEN; - { - use bytes; + SKIP: { + skip 'length() no longer calls len magic on plain scalars' => 16 + if VMG_COMPAT_SCALAR_LENGTH_NOLEN; + + $c = 0; + $n = 1 + int rand 1000; + # length magic on scalars needs also get magic to be triggered. + my $wiz = wizard get => sub { return 'anything' }, + len => sub { $d = $_[2]; ++$c; return $n }; + + my $x = 6789; + + $c = 0; + cast $x, $wiz; + is $c, 0, 'len: cast on scalar doesn\'t trigger magic'; $c = 0; $d = undef; $b = length $x; - is $c, 1, 'len: get utf8 scalar length in bytes triggers magic correctly'; - is $d, 7, 'len: get utf8 scalar length in bytes have correct default length'; - is $b, $d, 'len: get utf8 scalar length in bytes correctly'; - } + is $c, 1, 'len: get scalar length triggers magic correctly'; + is $d, 4, 'len: get scalar length have correct default length'; + is $b, $n, 'len: get scalar length correctly'; - $c = 0; - $d = undef; - $b = length $x; - is $c, 1, 'len: get utf8 scalar length triggers magic correctly'; - is $d, 5, 'len: get utf8 scalar length have correct default length'; - is $b, $d, 'len: get utf8 scalar length correctly'; -} + $n = 0; -{ - our $c; - # length magic on scalars needs also get magic to be triggered. - my $wiz = wizard get => sub { 0 }, - len => sub { $d = $_[2]; ++$c; return $_[2] }; + $c = 0; + $d = undef; + $b = length $x; + is $c, 1, 'len: get scalar length 0 triggers magic correctly'; + is $d, 4, 'len: get scalar length 0 have correct default length'; + is $b, $n, 'len: get scalar length 0 correctly'; - { - my $x = "banana"; + $n = undef; + $x = ''; cast $x, $wiz; - local $c = 0; - pos($x) = 2; - is $c, 1, 'len: pos scalar triggers magic correctly'; - is $d, 6, 'len: pos scalar have correct default length'; - is $x, 'banana', 'len: pos scalar works correctly' - } + $c = 0; + $d = undef; + $b = length $x; + is $c, 1, 'len: get empty scalar length triggers magic correctly'; + is $d, 0, 'len: get empty scalar length have correct default length'; + is $b, 0, 'len: get empty scalar length correctly'; - { - my $x = "hl\x{20AB}gh"; # Force utf8 on string + $x = "\x{20AB}ongs"; cast $x, $wiz; - local $c = 0; - substr($x, 2, 1) = 'a'; - is $c, 1, 'len: substr utf8 scalar triggers magic correctly'; - is $d, 5, 'len: substr utf8 scalar have correct default length'; - is $x, 'hlagh', 'len: substr utf8 scalar correctly'; + { + use bytes; + + $c = 0; + $d = undef; + $b = length $x; + is $c, 1, 'len: get utf8 scalar length in bytes triggers magic correctly'; + is $d, 7, 'len: get utf8 scalar length in bytes have correct default length'; + is $b, $d,'len: get utf8 scalar length in bytes correctly'; + } + + $c = 0; + $d = undef; + $b = length $x; + is $c, 1, 'len: get utf8 scalar length triggers magic correctly'; + is $d, 5, 'len: get utf8 scalar length have correct default length'; + is $b, $d, 'len: get utf8 scalar length correctly'; + } + + { + our $c; + # length magic on scalars needs also get magic to be triggered. + my $wiz = wizard get => sub { 0 }, + len => sub { $d = $_[2]; ++$c; return $_[2] }; + + { + my $x = "banana"; + cast $x, $wiz; + + local $c = 0; + pos($x) = 2; + is $c, 1, 'len: pos scalar triggers magic correctly'; + is $d, 6, 'len: pos scalar have correct default length'; + is $x, 'banana', 'len: pos scalar works correctly' + } + + { + my $x = "hl\x{20AB}gh"; # Force utf8 on string + cast $x, $wiz; + + local $c = 0; + substr($x, 2, 1) = 'a'; + is $c, 1, 'len: substr utf8 scalar triggers magic correctly'; + is $d, 5, 'len: substr utf8 scalar have correct default length'; + is $x, 'hlagh', 'len: substr utf8 scalar correctly'; + } } }