]> git.vpit.fr Git - perl/modules/indirect.git/commitdiff
Support variables with spaces after the sigil
authorVincent Pit <vince@profvince.com>
Thu, 16 Oct 2008 15:10:16 +0000 (17:10 +0200)
committerVincent Pit <vince@profvince.com>
Thu, 16 Oct 2008 15:10:16 +0000 (17:10 +0200)
indirect.xs
t/20-bad.t

index 53b23f60ce7bff4cd1918fafda55278f5e877d1e..7c0144689d9106519b44b62882a6749bdfb495db 100644 (file)
@@ -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;
index 8bd5602258260e7d5b2230be65bbcd3b56941eac..6c14518761826180e4167e5f8d62ab2f110b0136 100644 (file)
@@ -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: $_");
  }
 }