This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix potential null deref introduced by change #27716
[perl5.git] / perly.c
diff --git a/perly.c b/perly.c
index 91f3bb9..18f8606 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -1,6 +1,6 @@
 /*    perly.c
  *
- *    Copyright (c) 2004 Larry Wall
+ *    Copyright (c) 2004, 2005, 2006 Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -89,17 +89,11 @@ do {                                                \
        YYFPRINTF Args;                         \
 } while (0)
 
-#  define YYDSYMPRINT(Args)                    \
-do {                                           \
-    if (yydebug)                               \
-       yysymprint Args;                        \
-} while (0)
-
 #  define YYDSYMPRINTF(Title, Token, Value)                    \
 do {                                                           \
     if (yydebug) {                                             \
        YYFPRINTF (Perl_debug_log, "%s ", Title);               \
-       yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
+       yysymprint (Perl_debug_log,  Token, Value);     \
        YYFPRINTF (Perl_debug_log, "\n");                       \
     }                                                          \
 } while (0)
@@ -109,7 +103,7 @@ do {                                                                \
 `--------------------------------*/
 
 static void
-yysymprint (pTHX_ PerlIO *yyoutput, int yytype, const YYSTYPE *yyvaluep)
+yysymprint(PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
 {
     if (yytype < YYNTOKENS) {
        YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
@@ -189,7 +183,6 @@ do {                                        \
 
 #else /* !DEBUGGING */
 #  define YYDPRINTF(Args)
-#  define YYDSYMPRINT(Args)
 #  define YYDSYMPRINTF(Title, Token, Value)
 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
 #  define YY_REDUCE_PRINT(Rule)
@@ -250,6 +243,7 @@ yystpcpy (pTHX_ char *yydest, const char *yysrc)
 int
 Perl_yyparse (pTHX)
 {
+    dVAR;
     int yychar; /* The lookahead symbol.  */
     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
     int yynerrs; /* Number of syntax errors so far.  */
@@ -263,8 +257,8 @@ Perl_yyparse (pTHX)
     int yytoken = 0;
 
     /* two stacks and their tools:
-         `yyss': related to states,
-         `yyvs': related to semantic values,
+         yyss: related to states,
+         yyvs: related to semantic values,
 
          Refer to the stacks thru separate pointers, to allow yyoverflow
          to reallocate them elsewhere.  */
@@ -302,6 +296,11 @@ Perl_yyparse (pTHX)
          rule.  */
     int yylen;
 
+#ifdef PERL_MAD
+    if (PL_madskills)
+       return madparse();
+#endif
+
     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 
     ENTER;                     /* force stack free before we return */
@@ -310,8 +309,8 @@ Perl_yyparse (pTHX)
     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
 
-    yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
-    yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
+    yyss_sv = newSV(YYINITDEPTH * sizeof(short));
+    yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
     SAVEFREESV(yyss_sv);
     SAVEFREESV(yyvs_sv);
     yyss = (short *) SvPVX(yyss_sv);
@@ -320,9 +319,10 @@ Perl_yyparse (pTHX)
     yyssp = yyss;
     yyvsp = yyvs;
 #ifdef DEBUGGING
-    yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
+    yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
     SAVEFREESV(yyns_sv);
-    yyns = SvPVX_const(yyns_sv);
+    /* XXX This seems strange to cast char * to char ** */
+    yyns = (const char **) SvPVX(yyns_sv);
     yynsp = yyns;
 #endif
 
@@ -366,7 +366,8 @@ Perl_yyparse (pTHX)
         yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 #ifdef DEBUGGING
         SvGROW(yyns_sv, yystacksize * sizeof(char *));
-        yyns = SvPVX_const(yyns_sv);
+        /* XXX This seems strange to cast char * to char ** */
+        yyns = (const char **) SvPVX(yyns_sv);
         if (! yyns)
               goto yyoverflowlab;
         yynsp = yyns + yysize - 1;
@@ -407,7 +408,11 @@ Perl_yyparse (pTHX)
     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
     if (yychar == YYEMPTY) {
        YYDPRINTF ((Perl_debug_log, "Reading a token: "));
+#ifdef PERL_MAD
+       yychar = PL_madskills ? madlex() : yylex();
+#else
        yychar = yylex();
+#endif
 #  ifdef EBCDIC
        if (yychar >= 0 && yychar < 255) {
            yychar = NATIVE_TO_ASCII(yychar);
@@ -482,7 +487,7 @@ Perl_yyparse (pTHX)
     yylen = yyr2[yyn];
 
     /* If YYLEN is nonzero, implement the default value of the action:
-      `$$ = $1'.
+      "$$ = $1".
 
       Otherwise, the following line sets YYVAL to garbage.
       This behavior is undocumented and Bison
@@ -514,7 +519,7 @@ Perl_yyparse (pTHX)
     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
 #endif
 
-    /* Now `shift' the result of the reduction.  Determine what state
+    /* Now shift the result of the reduction.  Determine what state
          that goes to, based on the state we popped back to and the rule
          number reduced by.  */
 
@@ -565,7 +570,7 @@ Perl_yyparse (pTHX)
                    yysize += yystrlen (yytname[yyx]) + 15, yycount++;
            yysize += yystrlen ("syntax error, unexpected ") + 1;
            yysize += yystrlen (yytname[yytype]);
-           New(yymsg, yysize, char *);
+           Newx(yymsg, yysize, char *);
            if (yymsg != 0) {
                const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
                yyp = yystpcpy (yyp, yytname[yytype]);