From 4a273b91c8e47ab37c6dd310072403d4fe2d0fb9 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 29 Jun 2012 12:41:21 -0700 Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20crash=20with=20formats=20in=20sp?= =?utf8?q?ecial=20blocks?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Commit 421f30ed1e9 didn’t go far enough. If a special block happens to replace a stub, then a format trying to close over variables in the special block will be pointing to the wrong outer sub. Such stubs shouldn’t usually happen, but perl shouldn’t crash. --- perly.act | 7 +++++-- perly.h | 45 ++++++++++++++++++++------------------------- perly.tab | 6 +++--- perly.y | 2 +- t/comp/form_scope.t | 16 +++++++++++++++- 5 files changed, 44 insertions(+), 32 deletions(-) diff --git a/perly.act b/perly.act index ce830e3..6516b02 100644 --- a/perly.act +++ b/perly.act @@ -214,7 +214,7 @@ case 2: newFORM((ps[(2) - (4)].val.ival), (ps[(3) - (4)].val.opval), (ps[(4) - (4)].val.opval)); (yyval.opval) = (OP*)NULL; #endif - if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) { + if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) { SvREFCNT_inc_simple_void(fmtcv); pad_add_anon(fmtcv, OP_NULL); } @@ -1717,10 +1717,13 @@ case 2: { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; + +/* Line 1267 of yacc.c. */ + default: break; /* Generated from: - * 27cce68ad4844f1b8053bfc11206fb9f559e08be6cefd4a986aaa606c0e5fb38 perly.y + * efdb10e4176c622005697eec1ff496d913ef986c5297086baa5088bbd3aedaf2 perly.y * 38f866dcd8341ad3c0810347587113eb2c6ac7d4f33bdab75b020efce92865be regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index d185ee9..8925a2e 100644 --- a/perly.h +++ b/perly.h @@ -5,25 +5,27 @@ */ #ifdef PERL_CORE -/* A Bison parser, made by GNU Bison 2.4.3. */ +/* A Bison parser, made by GNU Bison 2.3. */ /* Skeleton interface for Bison's Yacc-like parsers in C - - Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - 2009, 2010 Free Software Foundation, Inc. - - This program is free software: you can redistribute it and/or modify + + Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 + Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - + the Free Software Foundation; either version 2, or (at your option) + any later version. + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - + You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work @@ -34,11 +36,10 @@ special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. - + This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ - /* Tokens. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE @@ -126,7 +127,6 @@ PEG = 336 }; #endif - /* Tokens. */ #define GRAMPROG 258 #define GRAMEXPR 259 @@ -210,13 +210,11 @@ + #endif /* PERL_CORE */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED typedef union YYSTYPE { - -/* Line 1685 of yacc.c */ - I32 ival; /* __DEFAULT__ (marker for regen_perly.pl; must always be 1st union member) */ char *pval; @@ -232,21 +230,18 @@ typedef union YYSTYPE #ifdef PERL_MAD TOKEN* tkval; #endif - - - -/* Line 1685 of yacc.c */ -} YYSTYPE; -# define YYSTYPE_IS_TRIVIAL 1 +} +/* Line 1529 of yacc.c. */ + YYSTYPE; # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 +# define YYSTYPE_IS_TRIVIAL 1 #endif - /* Generated from: - * 27cce68ad4844f1b8053bfc11206fb9f559e08be6cefd4a986aaa606c0e5fb38 perly.y + * efdb10e4176c622005697eec1ff496d913ef986c5297086baa5088bbd3aedaf2 perly.y * 38f866dcd8341ad3c0810347587113eb2c6ac7d4f33bdab75b020efce92865be regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 86cc024..309d5d9 100644 --- a/perly.tab +++ b/perly.tab @@ -223,9 +223,9 @@ static const char *const yytname[] = "':'", "DORDOR", "OROR", "ANDAND", "BITOROP", "BITANDOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "REFGEN", "UMINUS", "POWOP", "POSTDEC", "POSTINC", "PREDEC", "PREINC", "ARROW", "')'", "'('", "PEG", "$accept", - "grammar", "$@1", "$@2", "$@3", "$@4", "$@5", "$@6", "block", "remember", + "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "block", "remember", "mydefsv", "mblock", "mremember", "stmtseq", "fullstmt", "labfullstmt", - "barestmt", "$@7", "$@8", "sideff", "else", "cont", "mintro", "nexpr", + "barestmt", "@7", "@8", "sideff", "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "miexpr", "formname", "startsub", "startanonsub", "startformsub", "subname", "proto", "subattrlist", "myattrlist", "subbody", "expr", "listexpr", "listop", "@9", "method", @@ -1089,6 +1089,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 27cce68ad4844f1b8053bfc11206fb9f559e08be6cefd4a986aaa606c0e5fb38 perly.y + * efdb10e4176c622005697eec1ff496d913ef986c5297086baa5088bbd3aedaf2 perly.y * 38f866dcd8341ad3c0810347587113eb2c6ac7d4f33bdab75b020efce92865be regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index e103db4..c819b5b 100644 --- a/perly.y +++ b/perly.y @@ -292,7 +292,7 @@ barestmt: PLUGSTMT newFORM($2, $3, $4); $$ = (OP*)NULL; #endif - if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) { + if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) { SvREFCNT_inc_simple_void(fmtcv); pad_add_anon(fmtcv, OP_NULL); } diff --git a/t/comp/form_scope.t b/t/comp/form_scope.t index d805ffa..6344652 100644 --- a/t/comp/form_scope.t +++ b/t/comp/form_scope.t @@ -1,6 +1,6 @@ #!./perl -print "1..7\n"; +print "1..8\n"; # Tests bug #22977. Test case from Dave Mitchell. sub f ($); @@ -97,3 +97,17 @@ $next = $clo1; &$clo2(0); $next = $clo2; &$clo1(0); + +# This is a variation of bug #22977, which crashes or fails an assertion +# up to 5.16. +# Keep this test last if you want test numbers to be sane. +BEGIN { \&END } +END { + my $test = "ok 8"; + *STDOUT = *STDOUT5{FORMAT}; + write; + format STDOUT5 = +@<<<<<<< +$test +. +} -- 2.7.4