From: Vincent Pit <vince@profvince.com>
Date: Sun, 19 Oct 2008 23:42:54 +0000 (+0200)
Subject: Fix a rare edge case for package whose names are prefix of 'main'
X-Git-Tag: v0.08~3
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=c8c4f6a0ef3e302ef052516259c03de71e2a26b1

Fix a rare edge case for package whose names are prefix of 'main'
---

diff --git a/indirect.xs b/indirect.xs
index c6e18e7..f8312ac 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -183,15 +183,15 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) {
    const char *stash = HvNAME_get(PL_curstash);
    STRLEN stashlen = HvNAMELEN_get(PL_curstash);
 
-   if ((len < stashlen + 2) || strnNE(name, stash, stashlen)) {
+   if ((len < stashlen + 2) || strnNE(name, stash, stashlen)
+       || name[stashlen] != ':' || name[stashlen+1] != ':') {
     /* Failed again ? Try to remove main */
     stash = "main";
     stashlen = 4;
-    if ((len < stashlen + 2) || strnNE(name, stash, stashlen))
+    if ((len < stashlen + 2) || strnNE(name, stash, stashlen)
+        || name[stashlen] != ':' || name[stashlen+1] != ':')
      goto done;
    }
-   if (name[stashlen] != ':' || name[stashlen+1] != ':')
-    goto done;
 
    sv_setpvn(sv, "$", 1);
    stashlen += 2;
diff --git a/t/20-bad.t b/t/20-bad.t
index 01f6a28..a545108 100644
--- a/t/20-bad.t
+++ b/t/20-bad.t
@@ -9,7 +9,7 @@ package main;
 use strict;
 use warnings;
 
-use Test::More tests => 46 * 6 + 2;
+use Test::More tests => 47 * 6 + 2;
 
 my ($obj, $x);
 our ($y, $bloop);
@@ -163,6 +163,9 @@ meh $main::bloop;
 package sploosh;
 meh $bloop;
 ####
+package ma;
+meh $bloop;
+####
 package sploosh;
 our $sploosh;
 package main;