Added descriptions to tests in reverse.t

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index cac14b9..b60d720 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1735,7 +1735,7 @@ S_incline(pTHX_ const char *s)
 /* skip space before PL_thistoken */
 
 STATIC char *
-S_skipspace0(pTHX_ register char *s)
+S_skipspace0(pTHX_ char *s)
 {
     PERL_ARGS_ASSERT_SKIPSPACE0;
 
@@ -1756,7 +1756,7 @@ S_skipspace0(pTHX_ register char *s)
 /* skip space after PL_thistoken */
 
 STATIC char *
-S_skipspace1(pTHX_ register char *s)
+S_skipspace1(pTHX_ char *s)
 {
     const char *start = s;
     I32 startoff = start - SvPVX(PL_linestr);
@@ -1783,7 +1783,7 @@ S_skipspace1(pTHX_ register char *s)
 }
 
 STATIC char *
-S_skipspace2(pTHX_ register char *s, SV **svp)
+S_skipspace2(pTHX_ char *s, SV **svp)
 {
     char *start;
     const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
@@ -1836,7 +1836,7 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
  */
 
 STATIC char *
-S_skipspace(pTHX_ register char *s)
+S_skipspace(pTHX_ char *s)
 {
 #ifdef PERL_MAD
     char *start = s;
@@ -2110,7 +2110,7 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
  */
 
 STATIC char *
-S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
+S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
 {
     dVAR;
     char *s;
@@ -2159,14 +2159,14 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
  */
 
 STATIC void
-S_force_ident(pTHX_ register const char *s, int kind)
+S_force_ident(pTHX_ const char *s, int kind)
 {
     dVAR;
 
     PERL_ARGS_ASSERT_FORCE_IDENT;
 
-    if (*s) {
-       const STRLEN len = strlen(s);
+    if (s[0]) {
+       const STRLEN len = s[1] ? strlen(s) : 1; /* s = "\"" see yylex */
        OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn_flags(s, len,
                                                                 UTF ? SVf_UTF8 : 0));
        start_force(PL_curforce);
@@ -2966,6 +2966,9 @@ S_scan_const(pTHX_ char *start)
        this_utf8  = PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
     }
 
+    /* Protect sv from errors and fatal warnings. */
+    ENTER_with_name("scan_const");
+    SAVEFREESV(sv);
 
     while (s < send || dorange) {
 
@@ -3037,7 +3040,6 @@ S_scan_const(pTHX_ char *start)
 #endif
 
                 if (min > max) {
-                   SvREFCNT_dec(sv);
                    Perl_croak(aTHX_
                               "Invalid range \"%c-%c\" in transliteration operator",
                               (char)min, (char)max);
@@ -3096,7 +3098,6 @@ S_scan_const(pTHX_ char *start)
            /* range begins (ignore - as first or last char) */
            else if (*s == '-' && s+1 < send  && s != start) {
                if (didrange) {
-                   SvREFCNT_dec(sv);
                    Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
                }
                if (has_utf8
@@ -3723,6 +3724,7 @@ S_scan_const(pTHX_ char *start)
 
     /* return the substring (via pl_yylval) only if we parsed anything */
     if (s > PL_bufptr) {
+       SvREFCNT_inc_simple_void_NN(sv);
        if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
            const char *const key = PL_lex_inpat ? "qr" : "q";
            const STRLEN keylen = PL_lex_inpat ? 2 : 1;
@@ -3747,8 +3749,8 @@ S_scan_const(pTHX_ char *start)
                                type, typelen);
        }
        pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
-    } else
-       SvREFCNT_dec(sv);
+    }
+    LEAVE_with_name("scan_const");
     return s;
 }
 
@@ -3774,7 +3776,7 @@ S_scan_const(pTHX_ char *start)
 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
 
 STATIC int
-S_intuit_more(pTHX_ register char *s)
+S_intuit_more(pTHX_ char *s)
 {
     dVAR;
 
@@ -4223,7 +4225,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
 }
 
 STATIC char *
-S_filter_gets(pTHX_ register SV *sv, STRLEN append)
+S_filter_gets(pTHX_ SV *sv, STRLEN append)
 {
     dVAR;
 
@@ -8020,6 +8022,9 @@ Perl_yylex(pTHX)
                                  "Experimental \"%s\" subs not enabled",
                                   tmp == KEY_my    ? "my"    :
                                   tmp == KEY_state ? "state" : "our");
+                   Perl_ck_warner_d(aTHX_
+                       packWARN(WARN_EXPERIMENTAL__LEXICAL_SUBS),
+                       "The lexical_subs feature is experimental");
                    goto really_sub;
                }
                PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);
@@ -9019,6 +9024,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
     dVAR; dSP;
     HV * table = GvHV(PL_hintgv);               /* ^H */
     SV *res;
+    SV *errsv = NULL;
     SV **cvp;
     SV *cv, *typesv;
     const char *why1 = "", *why2 = "", *why3 = "";
@@ -9112,11 +9118,11 @@ now_ok:
     SPAGAIN ;
 
     /* Check the eval first */
-    if (!PL_in_eval && SvTRUE(ERRSV)) {
+    if (!PL_in_eval && ((errsv = ERRSV), SvTRUE_NN(errsv))) {
        STRLEN errlen;
        const char * errstr;
-       sv_catpvs(ERRSV, "Propagated");
-       errstr = SvPV_const(ERRSV, errlen);
+       sv_catpvs(errsv, "Propagated");
+       errstr = SvPV_const(errsv, errlen);
        yyerror_pvn(errstr, errlen, 0); /* Duplicates the message inside eval */
        (void)POPs;
        res = SvREFCNT_inc_simple(sv);
@@ -9146,7 +9152,7 @@ now_ok:
    *slp
    */
 STATIC char *
-S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
+S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
     dVAR;
     char *d = dest;
@@ -9189,7 +9195,7 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag
 }
 
 STATIC char *
-S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni)
+S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck_uni)
 {
     dVAR;
     char *bracket = NULL;
@@ -9773,7 +9779,7 @@ S_scan_trans(pTHX_ char *start)
 */
 
 STATIC char *
-S_scan_heredoc(pTHX_ register char *s)
+S_scan_heredoc(pTHX_ char *s)
 {
     dVAR;
     I32 op_type = OP_SCALAR;
@@ -10996,7 +11002,7 @@ vstring:
 }
 
 STATIC char *
-S_scan_formline(pTHX_ register char *s)
+S_scan_formline(pTHX_ char *s)
 {
     dVAR;
     char *eol;
@@ -11264,9 +11270,10 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
     else
        qerror(msg);
     if (PL_error_count >= 10) {
-       if (PL_in_eval && SvCUR(ERRSV))
+       SV * errsv;
+       if (PL_in_eval && ((errsv = ERRSV), SvCUR(errsv)))
            Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
-                      SVfARG(ERRSV), OutCopFILE(PL_curcop));
+                      SVfARG(errsv), OutCopFILE(PL_curcop));
        else
            Perl_croak(aTHX_ "%s has too many errors.\n",
             OutCopFILE(PL_curcop));