Make indirect_find() more resilient to embedded nuls

[perl/modules/indirect.git] / indirect.xs

diff --git a/indirect.xs b/indirect.xs
index 1bd3ffa662c923708e18167f4f2de0d1069a8257..e1961194bf1585b083f947d0201ceaca4bfed003 100644 (file)
--- a/indirect.xs
+++ b/indirect.xs
@@ -35,8 +35,12 @@
 # define SvPVX_const SvPVX
 #endif
 
-#ifndef SvREFCNT_inc_simple_NN
-# define SvREFCNT_inc_simple_NN SvREFCNT_inc
+#ifndef SvREFCNT_inc_simple_void_NN
+# ifdef SvREFCNT_inc_simple_NN
+#  define SvREFCNT_inc_simple_void_NN SvREFCNT_inc_simple_NN
+# else
+#  define SvREFCNT_inc_simple_void_NN SvREFCNT_inc
+# endif
 #endif
 
 #ifndef sv_catpvn_nomg
@@ -182,10 +186,10 @@ typedef SV indirect_hint_t;
  * thread cleanup. */
 
 typedef struct {
+ char   *buf;
  STRLEN  pos;
  STRLEN  size;
  STRLEN  len;
- char   *buf;
  line_t  line;
 } indirect_op_info_t;
 
@@ -338,7 +342,7 @@ STATIC SV *indirect_tag(pTHX_ SV *value) {
   value = SvRV(value);
   if (SvTYPE(value) >= SVt_PVCV) {
    code = value;
-   SvREFCNT_inc_simple_NN(code);
+   SvREFCNT_inc_simple_void_NN(code);
   }
  }
 
@@ -394,6 +398,11 @@ STATIC SV *indirect_hint(pTHX) {
  if (IN_PERL_RUNTIME)
   return NULL;
 
+#if I_HAS_PERL(5, 10, 0) || defined(PL_parser)
+ if (!PL_parser)
+  return NULL;
+#endif
+
 #ifdef cop_hints_fetch_pvn
  hint = cop_hints_fetch_pvn(PL_curcop, __PACKAGE__, __PACKAGE_LEN__,
                                                               indirect_hash, 0);
@@ -470,33 +479,66 @@ STATIC void indirect_map_delete(pTHX_ const OP *o) {
 
 /* --- Check functions ----------------------------------------------------- */
 
-STATIC int indirect_find(pTHX_ SV *sv, const char *s, STRLEN *pos) {
-#define indirect_find(N, S, P) indirect_find(aTHX_ (N), (S), (P))
- STRLEN len;
- const char *p, *r = SvPV_const(sv, len);
+STATIC STRLEN indirect_nextline(const char *s, STRLEN len) {
+ STRLEN i;
 
- if (len >= 1 && *r == '$') {
-  ++r;
-  --len;
-  s = strchr(s, '$');
-  if (!s)
+ for (i = 0; i < len; ++i) {
+  if (s[i] == '\n') {
+   ++i;
+   while (i < len && s[i] == '\r')
+    ++i;
+   break;
+  }
+ }
+
+ return i;
+}
+
+STATIC int indirect_find(pTHX_ SV *name_sv, const char *line_bufptr, STRLEN *name_pos) {
+#define indirect_find(NSV, LBP, NP) indirect_find(aTHX_ (NSV), (LBP), (NP))
+ STRLEN      name_len, line_len;
+ const char *name, *name_end;
+ const char *line, *line_end;
+ const char *p, *t, *u;
+
+ line     = SvPV_const(PL_linestr, line_len);
+ line_end = line + line_len;
+
+ name = SvPV_const(name_sv, name_len);
+ if (name_len >= 1 && *name == '$') {
+  ++name;
+  --name_len;
+  while (line_bufptr < line_end && *line_bufptr != '$')
+   ++line_bufptr;
+  if (line_bufptr >= line_end)
    return 0;
  }
+ name_end = name + name_len;
 
- p = s;
+ p = line_bufptr;
  while (1) {
-  p = strstr(p, r);
+  p = ninstr(p, line_end, name, name_end);
   if (!p)
    return 0;
-  if (!isALNUM(p[len]))
+  if (!isALNUM(p[name_len]))
    break;
-  /* p points to a word that has r as prefix, skip the rest of the word */
-  p += len + 1;
+  /* p points to a word that has name as prefix, skip the rest of the word */
+  p += name_len + 1;
   while (isALNUM(*p))
    ++p;
  }
 
- *pos = p - SvPVX_const(PL_linestr);
+ t = line;
+ u = t;
+ while (t <= p) {
+  STRLEN i = indirect_nextline(t, line_len);
+  if (i >= line_len)
+   break;
+  u         = t;
+  t        += i;
+  line_len -= i;
+ }
+ *name_pos = p - u;
 
  return 1;
 }
@@ -775,7 +817,8 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
   /* When positions are identical, the method and the object must have the
    * same name. But it also means that it is an indirect call, as "foo->foo"
    * results in different positions. */
-  if (moi->pos <= ooi->pos) {
+  if (   moi->line < ooi->line
+      || (moi->line == ooi->line && moi->pos <= ooi->pos)) {
    SV *file;
    dSP;