Improve and restructure t/op/pat.t and split out some unicode related tests into...
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 7b11def..d8cd2e5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -9,7 +9,9 @@
  */
 
 /*
- *   "It all comes from here, the stench and the peril."  --Frodo
+ *  'It all comes from here, the stench and the peril.'    --Frodo
+ *
+ *     [p.719 of _The Lord of the Rings_, IV/ix: "Shelob's Lair"]
  */
 
 /*
@@ -544,13 +546,7 @@ S_missingterm(pTHX_ char *s)
        if (nl)
            *nl = '\0';
     }
-    else if (
-#ifdef EBCDIC
-       iscntrl(PL_multi_close)
-#else
-       PL_multi_close < 32 || PL_multi_close == 127
-#endif
-       ) {
+    else if (isCNTRL(PL_multi_close)) {
        *tmpbuf = '^';
        tmpbuf[1] = (char)toCTRL(PL_multi_close);
        tmpbuf[2] = '\0';
@@ -717,7 +713,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
     parser->expect = XSTATE;
     parser->rsfp = rsfp;
     parser->rsfp_filters = (new_filter || !oparser) ? newAV()
-               : (AV*)SvREFCNT_inc(oparser->rsfp_filters);
+               : MUTABLE_AV(SvREFCNT_inc(oparser->rsfp_filters));
 
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
@@ -1119,17 +1115,17 @@ S_skipspace(pTHX_ register char *s)
            }
            else if (PL_minus_n) {
 #ifdef PERL_MAD
-               sv_catpvn(PL_linestr, ";}", 2);
+               sv_catpvs(PL_linestr, ";}");
 #else
-               sv_setpvn(PL_linestr, ";}", 2);
+               sv_setpvs(PL_linestr, ";}");
 #endif
                PL_minus_n = 0;
            }
            else
 #ifdef PERL_MAD
-               sv_catpvn(PL_linestr,";", 1);
+               sv_catpvs(PL_linestr,";");
 #else
-               sv_setpvn(PL_linestr,";", 1);
+               sv_setpvs(PL_linestr,";");
 #endif
 
            /* reset variables for next time we lex */
@@ -1179,7 +1175,7 @@ S_skipspace(pTHX_ register char *s)
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
         */
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(NULL, PL_bufptr, PL_bufend - PL_bufptr);
     }
 
@@ -1319,7 +1315,7 @@ S_curmad(pTHX_ char slot, SV *sv)
        where = &PL_nexttoke[PL_curforce].next_mad;
 
     if (PL_faketokens)
-       sv_setpvn(sv, "", 0);
+       sv_setpvs(sv, "");
     else {
        if (!IN_BYTES) {
            if (UTF && is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
@@ -1333,7 +1329,7 @@ S_curmad(pTHX_ char slot, SV *sv)
     /* keep a slot open for the head of the list? */
     if (slot != '_' && *where && (*where)->mad_key == '^') {
        (*where)->mad_key = slot;
-       sv_free((SV*)((*where)->mad_val));
+       sv_free(MUTABLE_SV(((*where)->mad_val)));
        (*where)->mad_val = (void*)sv;
     }
     else
@@ -1846,7 +1842,7 @@ S_sublex_done(pTHX)
                PL_thiswhite = 0;
            }
            if (PL_thistoken)
-               sv_setpvn(PL_thistoken,"",0);
+               sv_setpvs(PL_thistoken,"");
            else
                PL_realtokenstart = -1;
        }
@@ -3338,7 +3334,7 @@ Perl_yylex(pTHX)
            PL_thismad = PL_nexttoke[PL_lasttoke].next_mad;
            PL_nexttoke[PL_lasttoke].next_mad = 0;
            if (PL_thismad && PL_thismad->mad_key == '_') {
-               PL_thiswhite = (SV*)PL_thismad->mad_val;
+               PL_thiswhite = MUTABLE_SV(PL_thismad->mad_val);
                PL_thismad->mad_val = 0;
                mad_free(PL_thismad);
                PL_thismad = 0;
@@ -3691,7 +3687,7 @@ Perl_yylex(pTHX)
                    ++svp;
                    sv_catpvs(PL_linestr, ";");
                }
-               sv_free((SV*)PL_preambleav);
+               sv_free(MUTABLE_SV(PL_preambleav));
                PL_preambleav = NULL;
            }
            if (PL_minus_E)
@@ -3732,7 +3728,7 @@ Perl_yylex(pTHX)
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
-           if (PERLDB_LINE && PL_curstash != PL_debstash)
+           if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
                update_debugger_info(PL_linestr, NULL, 0);
            goto retry;
        }
@@ -3768,7 +3764,7 @@ Perl_yylex(pTHX)
                }
                PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                PL_last_lop = PL_last_uni = NULL;
-               sv_setpvn(PL_linestr,"",0);
+               sv_setpvs(PL_linestr,"");
                TOKEN(';');     /* not infinite loop because rsfp is NULL now */
            }
            /* If it looks like the start of a BOM or raw UTF-16,
@@ -3804,7 +3800,7 @@ Perl_yylex(pTHX)
                    sv_catsv(PL_thiswhite, PL_linestr);
 #endif
                if (*s == '=' && strnEQ(s, "=cut", 4) && !isALPHA(s[4])) {
-                   sv_setpvn(PL_linestr, "", 0);
+                   sv_setpvs(PL_linestr, "");
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_last_lop = PL_last_uni = NULL;
@@ -3814,7 +3810,7 @@ Perl_yylex(pTHX)
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(PL_linestr, NULL, 0);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
@@ -3987,17 +3983,17 @@ Perl_yylex(pTHX)
                            } while (argc && argv[0][0] == '-' && argv[0][1]);
                            init_argv_symbols(argc,argv);
                        }
-                       if ((PERLDB_LINE && !oldpdb) ||
+                       if (((PERLDB_LINE || PERLDB_SAVESRC) && !oldpdb) ||
                            ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
                              /* if we have already added "LINE: while (<>) {",
                                 we must not do it again */
                        {
-                           sv_setpvn(PL_linestr, "", 0);
+                           sv_setpvs(PL_linestr, "");
                            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                            PL_last_lop = PL_last_uni = NULL;
                            PL_preambled = FALSE;
-                           if (PERLDB_LINE)
+                           if (PERLDB_LINE || PERLDB_SAVESRC)
                                (void)gv_fetchfile(PL_origfilename);
                            goto retry;
                        }
@@ -4091,7 +4087,7 @@ Perl_yylex(pTHX)
                        if (!PL_thiswhite)
                            PL_thiswhite = newSVpvs("");
                        if (CopLINE(PL_curcop) == 1) {
-                           sv_setpvn(PL_thiswhite, "", 0);
+                           sv_setpvs(PL_thiswhite, "");
                            PL_faketokens = 0;
                        }
                        sv_catpvn(PL_thiswhite, s, d - s);
@@ -4655,7 +4651,7 @@ Perl_yylex(pTHX)
                    if (PL_madskills) {
                        if (!PL_thiswhite)
                            PL_thiswhite = newSVpvs("");
-                       sv_catpvn(PL_thiswhite,"}",1);
+                       sv_catpvs(PL_thiswhite,"}");
                    }
 #endif
                    return yylex();     /* ignore fake brackets */
@@ -4692,7 +4688,7 @@ Perl_yylex(pTHX)
                && isIDFIRST_lazy_if(s,UTF))
            {
                CopLINE_dec(PL_curcop);
-               Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
+               Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi);
                CopLINE_inc(PL_curcop);
            }
            BAop(OP_BIT_AND);
@@ -5360,7 +5356,7 @@ Perl_yylex(pTHX)
                if (PL_expect == XOPERATOR) {
                    if (PL_bufptr == PL_linestart) {
                        CopLINE_dec(PL_curcop);
-                       Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
+                       Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi);
                        CopLINE_inc(PL_curcop);
                    }
                    else
@@ -5442,7 +5438,7 @@ Perl_yylex(pTHX)
                    /* Real typeglob, so get the real subroutine: */
                           ? GvCVu(gv)
                    /* A proxy for a subroutine in this package? */
-                          : SvOK(gv) ? (CV *) gv : NULL)
+                          : SvOK(gv) ? MUTABLE_CV(gv) : NULL)
                    : NULL;
 
                /* See if it's the indirect object for a list operator. */
@@ -5591,7 +5587,7 @@ Perl_yylex(pTHX)
                        SvPOK(cv))
                    {
                        STRLEN protolen;
-                       const char *proto = SvPV_const((SV*)cv, protolen);
+                       const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
                        if (!protolen)
                            TERM(FUNC0SUB);
                        if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
@@ -6727,7 +6723,7 @@ Perl_yylex(pTHX)
                        Perl_croak(aTHX_ "Missing name in \"my sub\"");
                    PL_expect = XTERMBLOCK;
                    attrful = XATTRTERM;
-                   sv_setpvn(PL_subname,"?",1);
+                   sv_setpvs(PL_subname,"?");
                    have_name = FALSE;
                }
 
@@ -10981,10 +10977,10 @@ S_scan_pat(pTHX_ char *start, I32 type)
           matches.  */
        assert(type != OP_TRANS);
        if (PL_curstash) {
-           MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
+           MAGIC *mg = mg_find((const SV *)PL_curstash, PERL_MAGIC_symtab);
            U32 elements;
            if (!mg) {
-               mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0,
+               mg = sv_magicext(MUTABLE_SV(PL_curstash), 0, PERL_MAGIC_symtab, 0, 0,
                                 0);
            }
            elements = mg->mg_len / sizeof(PMOP**);
@@ -11410,7 +11406,7 @@ S_scan_heredoc(pTHX_ register char *s)
        PL_last_lop = PL_last_uni = NULL;
     }
     else
-       sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
+       sv_setpvs(tmpstr,"");   /* avoid "uninitialized" warning */
     while (s >= PL_bufend) {   /* multiple line string? */
 #ifdef PERL_MAD
        if (PL_madskills) {
@@ -11447,7 +11443,7 @@ S_scan_heredoc(pTHX_ register char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(PL_linestr, NULL, 0);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
@@ -11946,7 +11942,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        CopLINE_inc(PL_curcop);
 
        /* update debugger info */
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(PL_linestr, NULL, 0);
 
        /* having changed the buffer, we must update PL_bufend */
@@ -12565,12 +12561,12 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     save_item(PL_subname);
     SAVESPTR(PL_compcv);
 
-    PL_compcv = (CV*)newSV_type(is_format ? SVt_PVFM : SVt_PVCV);
+    PL_compcv = MUTABLE_CV(newSV_type(is_format ? SVt_PVFM : SVt_PVCV));
     CvFLAGS(PL_compcv) |= flags;
 
     PL_subline = CopLINE(PL_curcop);
     CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
-    CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outsidecv);
+    CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outsidecv));
     CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
 
     return oldsavestack_ix;
@@ -12907,7 +12903,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
        if (*s == 'v')
            s++;  /* get past 'v' */
 
-       sv_setpvn(sv, "", 0);
+       sv_setpvs(sv, "");
 
        for (;;) {
            /* this is atoi() that tolerates underscores */