diff options
| -rw-r--r-- | av.c | 11 | ||||
| -rw-r--r-- | pod/perldiag.pod | 9 | ||||
| -rwxr-xr-x | t/op/array.t | 17 |
3 files changed, 23 insertions, 14 deletions
@@ -940,21 +940,14 @@ Perl_av_arylen_p(pTHX_ AV *av) { MAGIC *mg = mg_find((SV*)av, PERL_MAGIC_arylen_p); if (!mg) { - mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, 0, 0, 0); + mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p, + 0, 0); if (!mg) { Perl_die(aTHX_ "panic: av_arylen_p"); } /* sv_magicext won't set this for us because we pass in a NULL obj */ mg->mg_flags |= MGf_REFCOUNTED; - - /* This is very naughty, but we don't want SvRMAGICAL() set on the - hash, because it slows down all accesses. If we pass in a vtable - to sv_magicext then it is (correctly) set for us. However, the only - entry in our vtable is for free, and mg_free always calls the free - vtable entry irrespective of the flags, so it doesn't actually - matter that the R flag is off. */ - mg->mg_virtual = &PL_vtbl_arylen_p; } return &(mg->mg_obj); } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 7a72ce71d5..c00ae54944 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -282,6 +282,15 @@ invalid anytime, even before the end of the current statement. Use literals or global values as arguments to the "p" pack() template to avoid this warning. +=item Attempt to set length of freed array + +(W) You tried to set the length of an array which has been freed. You +can do this by storing a reference to the scalar representing the last index +of an array and later assigning through that reference. For example + + $r = do {my @a; \$#a}; + $$r = 503 + =item Attempt to use reference as lvalue in substr (W substr) You supplied a reference as the first argument to substr() diff --git a/t/op/array.t b/t/op/array.t index 16a3df5bca..956a934290 100755 --- a/t/op/array.t +++ b/t/op/array.t @@ -7,7 +7,7 @@ BEGIN { require 'test.pl'; -plan (88); +plan (91); # # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them @@ -277,13 +277,20 @@ is ($got, ''); like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0"); } -{ +sub test_arylen { + my $ref = shift; local $^W = 1; - my $a = \$#{[]}; - is ($$a, undef, "\$# on freed array is undef"); + is ($$ref, undef, "\$# on freed array is undef"); my @warn; local $SIG{__WARN__} = sub {push @warn, "@_"}; - $$a = 1000; + $$ref = 1000; is (scalar @warn, 1); like ($warn[0], qr/^Attempt to set length of freed array/); } + +{ + my $a = \$#{[]}; + # Need a new statement to make it go out of scope + test_arylen ($a); + test_arylen (do {my @a; \$#a}); +} |