From: Vincent Pit Date: Thu, 4 Mar 2010 00:22:35 +0000 (+0100) Subject: Handle non-numeric hints X-Git-Tag: rt55154^0 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=212cf2f8511a55f57224f4e043d2328a1f840693;p=perl%2Fmodules%2Fautovivification.git Handle non-numeric hints We only create our hints as UVs, but we may still be getting non-numeric SVs if e.g. the autovivification introduction was generated from B::Deparse. This fixes RT #55154. --- diff --git a/MANIFEST b/MANIFEST index 21c20c2..988f9cb 100644 --- a/MANIFEST +++ b/MANIFEST @@ -15,6 +15,7 @@ t/31-array-fast.t t/32-array-kv.t t/40-scope.t t/41-padsv.t +t/42-deparse.t t/91-pod.t t/92-pod-coverage.t t/95-portability-files.t diff --git a/autovivification.xs b/autovivification.xs index cb81c0f..a8367a0 100644 --- a/autovivification.xs +++ b/autovivification.xs @@ -94,7 +94,18 @@ STATIC UV a_detag(pTHX_ const SV *hint) { #else /* A_WORKAROUND_REQUIRE_PROPAGATION */ #define a_tag(B) newSVuv(B) -#define a_detag(H) (((H) && SvOK(H)) ? SvUVX(H) : 0) +/* PVs fetched from the hints chain have their SvLEN set to zero, so get the UV + * from a copy. */ +#define a_detag(H) \ + ((H) \ + ? (SvIOK(H) \ + ? SvUVX(H) \ + : (SvPOK(H) \ + ? sv_2uv(SvLEN(H) ? (H) : sv_mortalcopy(H)) \ + : 0 \ + ) \ + ) \ + : 0) #endif /* !A_WORKAROUND_REQUIRE_PROPAGATION */ diff --git a/t/42-deparse.t b/t/42-deparse.t new file mode 100644 index 0000000..85ad4fc --- /dev/null +++ b/t/42-deparse.t @@ -0,0 +1,33 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +if (eval 'use B::Deparse; 1') { + plan tests => 2; +} else { + plan skip_all => 'B::Deparse is not available'; +} + +my $bd = B::Deparse->new; + +{ + no autovivification qw/fetch strict/; + + sub blech { my $key = $_[0]->{key} } +} + +{ + my $undef; + eval 'blech($undef)'; + like $@, qr/Reference vivification forbidden/, 'Original blech() works'; +} + +{ + my $code = $bd->coderef2text(\&blech); + my $undef; + eval "$code; blech(\$undef)"; + like $@, qr/Reference vivification forbidden/, 'Deparsed blech() works'; +}