X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=4ce10e59ce0dc8fae193abf93f0f81aa471bc3ba;hp=f0af0b68c699a2ca828e4ae2ae87de0cc45e8ab1;hb=ec48b957f1ab41d61e97f77b104a5b41f616af32;hpb=7328cc91a653de36dc35a3972821f77db9e1ca73

diff --git a/indirect.xs b/indirect.xs
index f0af0b6..4ce10e5 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -61,20 +61,6 @@
 
 #define I_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
 
-#undef ENTERn
-#if defined(ENTER_with_name) && !I_HAS_PERL(5, 11, 4)
-# define ENTERn(N) ENTER_with_name(N)
-#else
-# define ENTERn(N) ENTER
-#endif
-
-#undef LEAVEn
-#if defined(LEAVE_with_name) && !I_HAS_PERL(5, 11, 4)
-# define LEAVEn(N) LEAVE_with_name(N)
-#else
-# define LEAVEn(N) LEAVE
-#endif
-
 #if I_HAS_PERL(5, 10, 0) || defined(PL_parser)
 # ifndef PL_lex_inwhat
 #  define PL_lex_inwhat PL_parser->lex_inwhat
@@ -288,22 +274,13 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  ptable_hints_store(ud->tbl, ent->key, h2);
 }
 
-STATIC void indirect_thread_cleanup(pTHX_ void *);
+#include "reap.h"
 
 STATIC void indirect_thread_cleanup(pTHX_ void *ud) {
- int *level = ud;
+ dMY_CXT;
 
- if (*level) {
-  *level = 0;
-  LEAVE;
-  SAVEDESTRUCTOR_X(indirect_thread_cleanup, level);
-  ENTER;
- } else {
-  dMY_CXT;
-  PerlMemShared_free(level);
-  ptable_free(MY_CXT.map);
-  ptable_hints_free(MY_CXT.tbl);
- }
+ ptable_free(MY_CXT.map);
+ ptable_hints_free(MY_CXT.tbl);
 }
 
 #endif /* I_THREADSAFE */
@@ -672,28 +649,35 @@ STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0;
 STATIC OP *indirect_ck_method(pTHX_ OP *o) {
  if (indirect_hint()) {
   OP *op = cUNOPo->op_first;
-  const indirect_op_info_t *oi = indirect_map_fetch(op);
-  const char *s = NULL;
-  line_t line;
-  SV *sv;
 
-  if (oi && (s = oi->pos)) {
-   sv   = sv_2mortal(newSVpvn(oi->buf, oi->len));
-   line = oi->line; /* Keep the old line so that we really point to the first */
-  } else {
-   sv = cSVOPx_sv(op);
-   if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV))
-    goto done;
-   sv   = sv_mortalcopy(sv);
-   s    = indirect_find(sv, PL_oldbufptr);
-   line = CopLINE(&PL_compiling);
-  }
+  /* Indirect method call is only possible when the method is a bareword, so
+   * don't trip up on $obj->$meth. */
+  if (op && op->op_type == OP_CONST) {
+   const indirect_op_info_t *oi = indirect_map_fetch(op);
+   const char *s = NULL;
+   line_t line;
+   SV *sv;
+
+   if (oi && (s = oi->pos)) {
+    sv   = sv_2mortal(newSVpvn(oi->buf, oi->len));
+    /* Keep the old line so that we really point to the first line of the
+     * expression. */
+    line = oi->line;
+   } else {
+    sv = cSVOPx_sv(op);
+    if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV))
+     goto done;
+    sv   = sv_mortalcopy(sv);
+    s    = indirect_find(sv, PL_oldbufptr);
+    line = CopLINE(&PL_compiling);
+   }
 
-  o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
-  /* o may now be a method_named */
+   o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
+   /* o may now be a method_named */
 
-  indirect_map_store(o, s, sv, line);
-  return o;
+   indirect_map_store(o, s, sv, line);
+   return o;
+  }
  }
 
 done:
@@ -905,8 +889,7 @@ CLONE(...)
 PROTOTYPE: DISABLE
 PREINIT:
  ptable *t;
- int    *level;
-CODE:
+PPCODE:
  {
   my_cxt_t ud;
   dMY_CXT;
@@ -921,13 +904,8 @@ CODE:
   MY_CXT.tbl     = t;
   MY_CXT.owner   = aTHX;
  }
- {
-  level = PerlMemShared_malloc(sizeof *level);
-  *level = 1;
-  LEAVEn("sub");
-  SAVEDESTRUCTOR_X(indirect_thread_cleanup, level);
-  ENTERn("sub");
- }
+ reap(3, indirect_thread_cleanup, NULL);
+ XSRETURN(0);
 
 #endif