]> git.vpit.fr Git - perl/modules/autovivification.git/commitdiff
Handle non-numeric hints rt55154
authorVincent Pit <vince@profvince.com>
Thu, 4 Mar 2010 00:22:35 +0000 (01:22 +0100)
committerVincent Pit <vince@profvince.com>
Thu, 4 Mar 2010 00:22:35 +0000 (01:22 +0100)
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.

MANIFEST
autovivification.xs
t/42-deparse.t [new file with mode: 0644]

index 21c20c290063460d9237b16b6b7066afa54c6242..988f9cb72a15926300602f3b224982dd8a08ab2a 100644 (file)
--- 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
index cb81c0f95bfe27cc60ac3e5a0e85bb4ca2b21317..a8367a0a961e07b2f0b8665f4dec351e0c92e12d 100644 (file)
@@ -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 (file)
index 0000000..85ad4fc
--- /dev/null
@@ -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';
+}