readd missing perldelta.pod changes from changes#6339,6376

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index fc51d91..f39b3bd 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1208,6 +1208,7 @@ S_scan_const(pTHX_ char *start)
     register char *s = start;                  /* start of the constant */
     register char *d = SvPVX(sv);              /* destination for copies */
     bool dorange = FALSE;                      /* are we in a translit range? */
+    bool didrange = FALSE;                     /* did we just finish a range? */
     bool has_utf = FALSE;                      /* embedded \x{} */
     I32 len;                                   /* ? */
     UV uv;
@@ -1241,6 +1242,13 @@ S_scan_const(pTHX_ char *start)
                min = (U8)*d;                   /* first char in range */
                max = (U8)d[1];                 /* last char in range  */
 
+
+                if (min > max) {
+                    Perl_croak(aTHX_
+                           "Invalid [] range \"%c-%c\" in transliteration operator",
+                           min, max);
+                }
+
 #ifndef ASCIIish
                if ((isLOWER(min) && isLOWER(max)) ||
                    (isUPPER(min) && isUPPER(max))) {
@@ -1261,11 +1269,15 @@ S_scan_const(pTHX_ char *start)
 
                /* mark the range as done, and continue */
                dorange = FALSE;
+                didrange = TRUE;
                continue;
-           }
+           } 
 
            /* range begins (ignore - as first or last char) */
            else if (*s == '-' && s+1 < send  && s != start) {
+                if (didrange) { 
+                   Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
+                }
                if (utf) {
                    *d++ = (char)0xff;  /* use illegal utf8 byte--see pmtrans */
                    s++;
@@ -1273,7 +1285,9 @@ S_scan_const(pTHX_ char *start)
                }
                dorange = TRUE;
                s++;
-           }
+           } else {
+              didrange = FALSE;
+            }
        }
 
        /* if we get here, we're not doing a transliteration */
@@ -1392,7 +1406,7 @@ S_scan_const(pTHX_ char *start)
            default:
                {
                    dTHR;
-                   if (ckWARN(WARN_MISC) && isALNUM(*s) && *s != '_')
+                   if (ckWARN(WARN_MISC) && isALNUM(*s))
                        Perl_warner(aTHX_ WARN_MISC, 
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -1875,7 +1889,7 @@ S_incl_perldb(pTHX)
  * store private buffers and state information.
  *
  * The supplied datasv parameter is upgraded to a PVIO type
- * and the IoDIRP field is used to store the function pointer,
+ * and the IoDIRP/IoANY field is used to store the function pointer,
  * and IOf_FAKE_DIRP is enabled on datasv to mark this as such.
  * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
  * private use must be set using malloc'd pointers.
@@ -1893,7 +1907,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
        datasv = NEWSV(255,0);
     if (!SvUPGRADE(datasv, SVt_PVIO))
         Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
-    IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+    IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */
     IoFLAGS(datasv) |= IOf_FAKE_DIRP;
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
                          funcp, SvPV_nolen(datasv)));
@@ -1913,9 +1927,9 @@ Perl_filter_del(pTHX_ filter_t funcp)
        return;
     /* if filter is on top of stack (usual case) just pop it off */
     datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
-    if (IoDIRP(datasv) == (DIR*)funcp) {
+    if (IoANY(datasv) == (void *)funcp) {
        IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
-       IoDIRP(datasv) = (DIR*)NULL;
+       IoANY(datasv) = (void *)NULL;
        sv_free(av_pop(PL_rsfp_filters));
 
         return;
@@ -1975,7 +1989,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
        return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
     }
     /* Get function pointer hidden within datasv       */
-    funcp = (filter_t)IoDIRP(datasv);
+    funcp = (filter_t)IoANY(datasv);
     DEBUG_P(PerlIO_printf(Perl_debug_log,
                          "filter_read %d: via function %p (%s)\n",
                          idx, funcp, SvPV_nolen(datasv)));
@@ -3158,7 +3172,7 @@ Perl_yylex(pTHX)
            yyerror("Unmatched right curly bracket");
        else
            PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
-       if (PL_lex_brackets < PL_lex_formbrack)
+       if (PL_lex_brackets < PL_lex_formbrack && PL_lex_state != LEX_INTERPNORMAL)
            PL_lex_formbrack = 0;
        if (PL_lex_state == LEX_INTERPNORMAL) {
            if (PL_lex_brackets == 0) {
@@ -7162,7 +7176,7 @@ S_scan_formline(pTHX_ register char *s)
     bool needargs = FALSE;
 
     while (!needargs) {
-       if (*s == '.' || *s == '}') {
+       if (*s == '.' || *s == /*{*/'}') {
            /*SUPPRESS 530*/
 #ifdef PERL_STRICT_CR
            for (t = s+1;SPACE_OR_TAB(*t); t++) ;