From: Vincent Pit <vince@profvince.com>
Date: Sun, 21 Sep 2014 19:44:42 +0000 (+0200)
Subject: Don't segfault for indirect constructs inside the empty package
X-Git-Tag: v0.32~2
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=217e4a123f681f91cd2cfb1e6eb001a9cb757d66;p=perl%2Fmodules%2Findirect.git

Don't segfault for indirect constructs inside the empty package

The empty package was an old feature that was removed in perl 5.10.
---

diff --git a/indirect.xs b/indirect.xs
index de41fa6..511d9cd 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -587,7 +587,8 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) {
      * when we already had a match because __PACKAGE__ can only appear in
      * direct method calls ("new __PACKAGE__" is a syntax error). */
     len = SvCUR(sv);
-    if (len == (STRLEN) HvNAMELEN_get(PL_curstash)
+    if (PL_curstash
+        && len == (STRLEN) HvNAMELEN_get(PL_curstash)
         && memcmp(SvPVX(sv), HvNAME_get(PL_curstash), len) == 0) {
      STRLEN pos_pkg;
      SV    *pkg = sv_newmortal();
diff --git a/t/50-external.t b/t/50-external.t
index 9e80f01..2476cd6 100644
--- a/t/50-external.t
+++ b/t/50-external.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 4;
 
 use lib 't/lib';
 use VPIT::TestHelpers;
@@ -28,3 +28,15 @@ SKIP:
  my $status = run_perl "use Devel::CallParser (); no indirect; sub ok { } ok 1";
  is $status, 0, 'indirect is not getting upset by Devel::CallParser';
 }
+
+SKIP:
+{
+ my $has_package_empty = do {
+  local $@;
+  eval 'no warnings "deprecated"; package; 1'
+ };
+ skip 'Empty package only available on perl 5.8.x and below' => 1
+                                                      unless $has_package_empty;
+ my $status = run_perl 'no indirect hook => sub { }; exit 0; package; new X;';
+ is $status, 0, 'indirect does not croak while package empty is in use';
+}