From: Vincent Pit <vince@profvince.com>
Date: Thu, 16 Oct 2008 15:10:16 +0000 (+0200)
Subject: Support variables with spaces after the sigil
X-Git-Tag: v0.07_03~3
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=3b965096935eb9216e70a0f6b8ab70d156fb371a

Support variables with spaces after the sigil
---

diff --git a/indirect.xs b/indirect.xs
index 53b23f6..7c01446 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -112,6 +112,14 @@ STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) {
  STRLEN len;
  const char *p = NULL, *r = SvPV_const(sv, len);
 
+ if (len >= 1 && *r == '$') {
+  ++r;
+  --len;
+  s = strchr(s, '$');
+  if (!s)
+   return NULL;
+ }
+
  p = strstr(s, r);
  while (p) {
   p += len;
@@ -214,10 +222,15 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) {
   const char *s = PL_parser->oldbufptr, *t = PL_parser->bufptr - 1;
 
   while (s < t && isSPACE(*s)) ++s;
-  while (t > s && isSPACE(*t)) --t;
-  sv = sv_2mortal(newSVpvn(s, t - s + 1));
-
-  indirect_map_store(o, s, sv);
+  if (*s == '$' && ++s <= t) {
+   while (s < t && isSPACE(*s)) ++s;
+   while (s < t && isSPACE(*t)) --t;
+   if (!isALPHA(*s))
+    return o;
+   sv = sv_2mortal(newSVpvn("$", 1));
+   sv_catpvn_nomg(sv, s, t - s + 1);
+   indirect_map_store(o, s, sv);
+  }
  }
 
  return o;
diff --git a/t/20-bad.t b/t/20-bad.t
index 8bd5602..6c14518 100644
--- a/t/20-bad.t
+++ b/t/20-bad.t
@@ -9,14 +9,14 @@ package main;
 use strict;
 use warnings;
 
-use Test::More tests => 44 * 4 + 2;
+use Test::More tests => 44 * 6 + 2;
 
 my ($obj, $x);
 our ($y, $bloop);
 
 sub expect {
  my ($pkg) = @_;
- return  qr/^warn:Indirect call of method "(?:new|meh|$pkg$pkg)" on object "(?:$pkg|newnew|\$(?:[xy_]|(?:sploosh::)?sploosh|(?:main::)?bloop))"/
+ return qr/^warn:Indirect call of method "(?:new|meh|$pkg$pkg)" on object "(?:$pkg|newnew|\$(?:[xy_]|(?:sploosh::)?sploosh|(?:main::)?bloop))"/
 }
 
 {
@@ -45,6 +45,18 @@ sub expect {
    eval "die qq{the code compiled but it shouldn't have\n}; $_";
   }
   like($@, expect('Dongs'), "no indirect, defined: $_");
+  s/\$/\$ \n\t /g;
+  s/Dongs/Hlagh/g;
+  {
+   use indirect;
+   eval "die qq{ok\\n}; $_";
+  }
+  is($@, "ok\n", "use indirect, spaces: $_");
+  {
+   no indirect;
+   eval "die qq{the code compiled but it shouldn't have\n}; $_";
+  }
+  like($@, expect('Hlagh'), "no indirect, spaces: $_");
  }
 }