Add strip_names_and_args

[p5sagit/Devel-Declare.git] / Declare.xs

diff --git a/Declare.xs b/Declare.xs
index af640e9..edfbc0d 100644 (file)
--- a/Declare.xs
+++ b/Declare.xs
@@ -53,7 +53,7 @@ int dd_is_declarator(pTHX_ char* name) {
   /* $declarators{$current_package_name} */
 
   if (!HvNAME(PL_curstash))
-         return -1;
+    return -1;
 
   is_declarator_pack_ref = hv_fetch(is_declarator, HvNAME(PL_curstash),
                              strlen(HvNAME(PL_curstash)), FALSE);
@@ -73,7 +73,7 @@ int dd_is_declarator(pTHX_ char* name) {
   /* requires SvIOK as well as TRUE since flags not being an int is useless */
 
   if (!is_declarator_flag_ref
-        || !SvIOK(*is_declarator_flag_ref) 
+        || !SvIOK(*is_declarator_flag_ref)
         || !SvTRUE(*is_declarator_flag_ref))
     return -1;
 
@@ -114,7 +114,7 @@ char* dd_get_linestr(pTHX) {
 }
 
 void dd_set_linestr(pTHX_ char* new_value) {
-  int new_len = strlen(new_value);
+  unsigned int new_len = strlen(new_value);
 
   if (SvLEN(PL_linestr) < new_len) {
     croak("forced to realloc PL_linestr for line %s, bailing out before we crash harder", SvPVX(PL_linestr));
@@ -179,9 +179,25 @@ int dd_toke_scan_word(pTHX_ int offset, int handle_package) {
   return s - base_s;
 }
 
+int dd_toke_scan_ident(pTHX_ int offset) {
+    char tmpbuf[sizeof PL_tokenbuf];
+    char* base_s = SvPVX(PL_linestr) + offset;
+    char* s = scan_ident(base_s, PL_bufend, tmpbuf, sizeof tmpbuf, 0);
+    return s - base_s;
+}
+
 int dd_toke_scan_str(pTHX_ int offset) {
+  STRLEN remaining = sv_len(PL_linestr) - offset;
+  SV* line_copy = newSVsv(PL_linestr);
   char* base_s = SvPVX(PL_linestr) + offset;
   char* s = scan_str(base_s, FALSE, FALSE);
+  if (s != base_s && sv_len(PL_lex_stuff) > remaining) {
+    int ret = (s - SvPVX(PL_linestr)) + remaining;
+    sv_catsv(line_copy, PL_linestr);
+    dd_set_linestr(aTHX_ SvPV_nolen(line_copy));
+    SvREFCNT_dec(line_copy);
+    return ret;
+  }
   return s - base_s;
 }
 
@@ -194,9 +210,12 @@ int dd_toke_skipspace(pTHX_ int offset) {
 /* replacement PL_check rv2cv entry */
 
 STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
+  dSP;
   OP* kid;
   int dd_flags;
 
+  PERL_UNUSED_VAR(user_data);
+
   if (in_declare) {
     if (dd_debug) {
       printf("Deconstructing declare\n");
@@ -206,13 +225,11 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
       printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
     }
 
-    dSP;
-  
     ENTER;
     SAVETMPS;
-  
+
     PUSHMARK(SP);
-  
+
     call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD);
 
     FREETMPS;
@@ -257,9 +274,16 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
 
 OP* dd_pp_entereval(pTHX) {
   dSP;
-  dPOPss;
   STRLEN len;
   const char* s;
+  SV *sv;
+#ifdef PERL_5_9_PLUS
+  SV *saved_hh;
+  if (PL_op->op_private & OPpEVAL_HAS_HH) {
+    saved_hh = POPs;
+  }
+#endif
+  sv = POPs;
   if (SvPOK(sv)) {
     if (dd_debug) {
       printf("mangling eval sv\n");
@@ -276,10 +300,17 @@ OP* dd_pp_entereval(pTHX) {
     SvGROW(sv, 8192);
   }
   PUSHs(sv);
+#ifdef PERL_5_9_PLUS
+  if (PL_op->op_private & OPpEVAL_HAS_HH) {
+    PUSHs(saved_hh);
+  }
+#endif
   return PL_ppaddr[OP_ENTEREVAL](aTHX);
 }
 
 STATIC OP *dd_ck_entereval(pTHX_ OP *o, void *user_data) {
+  PERL_UNUSED_VAR(user_data);
+
   if (o->op_ppaddr == PL_ppaddr[OP_ENTEREVAL])
     o->op_ppaddr = dd_pp_entereval;
   return o;
@@ -297,6 +328,12 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) {
   int dd_flags;
   char* name;
 
+  PERL_UNUSED_VAR(user_data);
+
+  if (DD_HAVE_PARSER && PL_expect == XOPERATOR) {
+    return o;
+  }
+
   /* if this is set, we just grabbed a delimited string or something,
      not a bareword, so NO TOUCHY */
 
@@ -314,9 +351,22 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) {
   if (dd_flags == -1)
     return o;
 
+  switch (PL_lex_inwhat) {
+    case OP_QR:
+    case OP_MATCH:
+    case OP_SUBST:
+    case OP_TRANS:
+    case OP_BACKTICK:
+    case OP_STRINGIFY:
+      return o;
+      break;
+    default:
+      break;
+  }
+
   dd_linestr_callback(aTHX_ "const", name);
 
-  return o;  
+  return o;
 }
 
 static int initialized = 0;
@@ -395,6 +445,13 @@ toke_scan_str(int offset);
     RETVAL
 
 int
+toke_scan_ident(int offset)
+  CODE:
+    RETVAL = dd_toke_scan_ident(aTHX_ offset);
+  OUTPUT:
+    RETVAL
+
+int
 toke_skipspace(int offset)
   CODE:
     RETVAL = dd_toke_skipspace(aTHX_ offset);