Fix invalid token warning with PERL_XMLDUMP and label

Under mad builds, commit 5db1eb8 caused this warning:

$ PERL_XMLDUMP=/dev/null ./perl -Ilib -e 'foo:'
Invalid TOKEN object ignored at -e line 1.

Since I don’t understand the mad code so well, the easiest fix is to
revert back to using a PV, as we did before 5db1eb8.  To record the
utf8ness, we sneak it behind the trailing null.

diff --git a/perly.act b/perly.act
index ed4115f..fae0f13 100644 (file)
--- a/perly.act
+++ b/perly.act
@@ -190,21 +190,21 @@ case 2:
   case 25:
 #line 278 "perly.y"
     {
-                         (yyval.opval) = newSTATEOP(SvUTF8(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv),
-                                        savepv(SvPVX(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv)), (ps[(2) - (2)].val.opval));
+                         (yyval.opval) = newSTATEOP(SVf_UTF8
+                                          * PVAL((ps[(1) - (2)].val.p_tkval))[strlen(PVAL((ps[(1) - (2)].val.p_tkval)))+1],
+                                         PVAL((ps[(1) - (2)].val.p_tkval)), (ps[(2) - (2)].val.opval));
                          TOKEN_GETMAD((ps[(1) - (2)].val.p_tkval),
                              (ps[(2) - (2)].val.opval) ? cLISTOPx((yyval.opval))->op_first : (yyval.opval), 'L');
-                         op_free((OP*)(ps[(1) - (2)].val.p_tkval));
                        ;}
     break;
 
   case 26:
 #line 286 "perly.y"
     {
-                         (yyval.opval) = newSTATEOP(SvUTF8(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv),
-                                        savepv(SvPVX(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv)), (ps[(2) - (2)].val.opval));
+                         (yyval.opval) = newSTATEOP(SVf_UTF8
+                                          * PVAL((ps[(1) - (2)].val.p_tkval))[strlen(PVAL((ps[(1) - (2)].val.p_tkval)))+1],
+                                         PVAL((ps[(1) - (2)].val.p_tkval)), (ps[(2) - (2)].val.opval));
                          TOKEN_GETMAD((ps[(1) - (2)].val.p_tkval), cLISTOPx((yyval.opval))->op_first, 'L');
-                         op_free((OP*)(ps[(1) - (2)].val.p_tkval));
                        ;}
     break;
 
@@ -1781,6 +1781,6 @@ case 2:
     
 
 /* Generated from:
- * f140f4bf4565d188246d4b85b0baf052281eeed1824a5697fcb811727a34da08 perly.y
+ * 28c2c7738eefc00762e227af0363c729186c992e9127e0c935684cccbf3a3b4f perly.y
  * 73288b53f1f6dc0183252a5a8e4f39cfe36e357e77233704fad3021fee88eb5b regen_perly.pl
  * ex: set ro: */

diff --git a/perly.h b/perly.h
index 53ef5d9..f32d64d 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -266,6 +266,6 @@ typedef union YYSTYPE
 
 
 /* Generated from:
- * f140f4bf4565d188246d4b85b0baf052281eeed1824a5697fcb811727a34da08 perly.y
+ * 28c2c7738eefc00762e227af0363c729186c992e9127e0c935684cccbf3a3b4f perly.y
  * 73288b53f1f6dc0183252a5a8e4f39cfe36e357e77233704fad3021fee88eb5b regen_perly.pl
  * ex: set ro: */

diff --git a/perly.tab b/perly.tab
index 9066388..6f0ac94 100644 (file)
--- a/perly.tab
+++ b/perly.tab
@@ -1127,6 +1127,6 @@ static const toketypes yy_type_tab[] =
 };
 
 /* Generated from:
- * f140f4bf4565d188246d4b85b0baf052281eeed1824a5697fcb811727a34da08 perly.y
+ * 28c2c7738eefc00762e227af0363c729186c992e9127e0c935684cccbf3a3b4f perly.y
  * 73288b53f1f6dc0183252a5a8e4f39cfe36e357e77233704fad3021fee88eb5b regen_perly.pl
  * ex: set ro: */

diff --git a/perly.y b/perly.y
index 704728e..91a7613 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -276,18 +276,18 @@ fullstmt: barestmt
 
 labfullstmt:   LABEL barestmt
                        {
-                         $$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
-                                        savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
+                         $$ = newSTATEOP(SVf_UTF8
+                                          * PVAL($1)[strlen(PVAL($1))+1],
+                                         PVAL($1), $2);
                          TOKEN_GETMAD($1,
                              $2 ? cLISTOPx($$)->op_first : $$, 'L');
-                         op_free((OP*)$1);
                        }
        |       LABEL labfullstmt
                        {
-                         $$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
-                                        savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
+                         $$ = newSTATEOP(SVf_UTF8
+                                          * PVAL($1)[strlen(PVAL($1))+1],
+                                         PVAL($1), $2);
                          TOKEN_GETMAD($1, cLISTOPx($$)->op_first, 'L');
-                         op_free((OP*)$1);
                        }
        ;
 

diff --git a/toke.c b/toke.c
index a382619..46ad0a4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -358,7 +358,7 @@ static struct debug_tokens {
     { GIVEN,           TOKENTYPE_IVAL,         "GIVEN" },
     { HASHBRACK,       TOKENTYPE_NONE,         "HASHBRACK" },
     { IF,              TOKENTYPE_IVAL,         "IF" },
-    { LABEL,           TOKENTYPE_OPVAL,        "LABEL" },
+    { LABEL,           TOKENTYPE_PVAL,         "LABEL" },
     { LOCAL,           TOKENTYPE_IVAL,         "LOCAL" },
     { LOOPEX,          TOKENTYPE_OPNUM,        "LOOPEX" },
     { LSTOP,           TOKENTYPE_OPNUM,        "LSTOP" },
@@ -4278,7 +4278,6 @@ Perl_madlex(pTHX)
     case FUNC0SUB:
     case UNIOPSUB:
     case LSTOPSUB:
-    case LABEL:
        if (pl_yylval.opval)
            append_madprops(PL_thismad, pl_yylval.opval, 0);
        PL_thismad = 0;
@@ -4293,6 +4292,10 @@ Perl_madlex(pTHX)
        }
        break;
 
+    /* pval */
+    case LABEL:
+       break;
+
     case ']':
     case '}':
        if (PL_faketokens)
@@ -6712,9 +6715,9 @@ Perl_yylex(pTHX)
        if (!anydelim && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
            s = d + 1;
-           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
-                                            newSVpvn_flags(PL_tokenbuf,
-                                                        len, UTF ? SVf_UTF8 : 0));
+           pl_yylval.pval = savepvn(PL_tokenbuf, len+1);
+           pl_yylval.pval[len] = '\0';
+           pl_yylval.pval[len+1] = UTF ? 1 : 0;
            CLINE;
            TOKEN(LABEL);
        }
@@ -11763,11 +11766,10 @@ Perl_parse_label(pTHX_ U32 flags)
     if (PL_lex_state == LEX_KNOWNEXT) {
        PL_parser->yychar = yylex();
        if (PL_parser->yychar == LABEL) {
-           SV *lsv;
+           char * const lpv = pl_yylval.pval;
+           STRLEN llen = strlen(lpv);
            PL_parser->yychar = YYEMPTY;
-           lsv = newSV_type(SVt_PV);
-           sv_copypv(lsv, cSVOPx(pl_yylval.opval)->op_sv);
-           return lsv;
+           return newSVpvn_flags(lpv, llen, lpv[llen+1] ? SVf_UTF8 : 0);
        } else {
            yyunlex();
            goto no_label;