]> git.vpit.fr Git - perl/modules/indirect.git/commitdiff
Don't segfault for indirect constructs inside the empty package
authorVincent Pit <vince@profvince.com>
Sun, 21 Sep 2014 19:44:42 +0000 (21:44 +0200)
committerVincent Pit <vince@profvince.com>
Sun, 21 Sep 2014 19:44:42 +0000 (21:44 +0200)
The empty package was an old feature that was removed in perl 5.10.

indirect.xs
t/50-external.t

index de41fa61802e60fff95101fd70cea563d3328313..511d9cd81df75d069f87cbe101929a9af17117e0 100644 (file)
@@ -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();
index 9e80f01678ffa7522bfa94b8752a7c1bf02f5331..2476cd68421f883b2a2e7fb4909a91af6e988068 100644 (file)
@@ -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';
+}