]> git.vpit.fr Git - perl/modules/Lexical-Types.git/commitdiff
The last argument to hv_fetch is the lvalue flag, not the hash
authorVincent Pit <vince@profvince.com>
Wed, 24 Aug 2011 15:48:45 +0000 (17:48 +0200)
committerVincent Pit <vince@profvince.com>
Wed, 24 Aug 2011 15:59:24 +0000 (17:59 +0200)
This could have caused entry vivifications in %^H on 5.8.

MANIFEST
Types.xs
t/18-hints.t [new file with mode: 0644]

index 9d43dcd4250dc4969253ca3187b24abe64b3cddd..1a363a3af6b5ef755452ee3b66e70d570714dbe8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -17,6 +17,7 @@ t/14-ro.t
 t/15-constants.t
 t/16-scope.t
 t/17-peep.t
+t/18-hints.t
 t/20-object.t
 t/21-tie.t
 t/22-magic.t
index 1e763696ffd4d3d1a139f5dbed301750e8e1334d..bcd59085981e704c2f5380b67e4acd35732488d6 100644 (file)
--- a/Types.xs
+++ b/Types.xs
@@ -354,7 +354,7 @@ STATIC SV *lt_hint(pTHX) {
                                        0,
                                        lt_hash);
 #else
- SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, lt_hash);
+ SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, 0);
  if (!val)
   return 0;
  hint = *val;
diff --git a/t/18-hints.t b/t/18-hints.t
new file mode 100644 (file)
index 0000000..2b0886c
--- /dev/null
@@ -0,0 +1,33 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+{
+ local %^H = (a => 1);
+
+ require Lexical::Types;
+
+ my $err = do {
+  local $@;
+  eval <<'  VIVIFICATION_TEST';
+   package Lexical::Types::TestVivification;
+   sub TYPEDSCALAR { }
+   my Lexical::Types::TestVivification $lexical;
+  VIVIFICATION_TEST
+  $@;
+ };
+
+ # Force %^H repopulation with an Unicode match
+ my $x = "foo";
+ utf8::upgrade($x);
+ $x =~ /foo/i;
+
+ my $hints = join ',',
+              map { $_, defined $^H{$_} ? $^H{$_} : '(undef)' }
+               sort keys(%^H);
+ is $err,   '',    'vivification test code did not croak';
+ is $hints, 'a,1', 'Lexical::Types does not vivify entries in %^H';
+}