From: Vincent Pit 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/?a=commitdiff_plain;h=3b965096935eb9216e70a0f6b8ab70d156fb371a;p=perl%2Fmodules%2Findirect.git 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: $_"); } }