Make the toke.c functions always operate on PL_compiling, even if we call them at...
[p5sagit/Devel-Declare.git] / Declare.xs
index 7e96835..edfbc0d 100644 (file)
@@ -36,8 +36,6 @@ static int in_declare = 0;
 #define DD_AM_LEXING DD_AM_LEXING_CHECK
 #endif
 
-static OP *previous_op = NULL;
-
 /* thing that decides whether we're dealing with a declarator */
 
 int dd_is_declarator(pTHX_ char* name) {
@@ -55,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);
@@ -75,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;
 
@@ -189,8 +187,17 @@ int dd_toke_scan_ident(pTHX_ int offset) {
 }
 
 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;
 }
 
@@ -323,6 +330,10 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) {
 
   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 */
 
@@ -340,28 +351,21 @@ STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) {
   if (dd_flags == -1)
     return o;
 
-  if (previous_op != NULL) {
-    switch (previous_op->op_type) {
-      case OP_QR:
-      case OP_MATCH:
-      case OP_SUBST:
-      case OP_TRANS:
-        return o;
-        break;
-      default:
-        break;
-    }
+  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;
-}
+  dd_linestr_callback(aTHX_ "const", name);
 
-STATIC OP *
-remember_previous_op (pTHX_ OP *o, void *user_data)
-{
-  PERL_UNUSED_VAR (user_data);
-  previous_op = o;
   return o;
 }
 
@@ -373,17 +377,12 @@ PROTOTYPES: DISABLE
 
 void
 setup()
-  PREINIT:
-    I32 i;
   CODE:
   if (!initialized++) {
     hook_op_check(OP_RV2CV, dd_ck_rv2cv, NULL);
     hook_op_check(OP_ENTEREVAL, dd_ck_entereval, NULL);
     hook_op_check(OP_CONST, dd_ck_const, NULL);
   }
-  for (i = 0; i < OP_max; i++) {
-    (void)hook_op_check(i, remember_previous_op, NULL);
-  }
   filter_add(dd_filter_realloc, NULL);
 
 char*