In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/aea0412a260d9d7295c0a5bebb8bb6978dc02ccd?hp=4caf7d8c4666d39b6b752a52ec5e19d9504f5f31>
- Log ----------------------------------------------------------------- commit aea0412a260d9d7295c0a5bebb8bb6978dc02ccd Author: David Mitchell <[email protected]> Date: Mon Mar 28 15:36:42 2016 +0100 RT #127786: assertion failure with eval in DB pkg. Normally a cloned anon sud has a NULL CvOUTSIDE(), unless that sub can contain code that will do an eval. However, calling eval from within the DB package pretends that the eval was done in the caller's scope. which then trips up on the NULL CvOUTSIDE(). ts) M op.c M t/op/eval.t commit daeb874b6b0d9720a5b3cffd11054bd7d7678888 Author: David Mitchell <[email protected]> Date: Mon Mar 28 09:59:10 2016 +0100 re_exec_indentf,re_indentf: silence warnings Pass the right types to printf. For re_exec_indentf(), really the type of the depth arg should be changed so that it and the depth var are consistent throughout regexec.c, but that's probably something for post-5.24. M regcomp.c M regexec.c commit 9d9905599cad5eeb33b2a64c023b97005694fbcd Author: David Mitchell <[email protected]> Date: Mon Mar 28 10:52:18 2016 +0100 silence -Wparentheses-equality Clang has taken it upon itself to warn when an equality is wrapped in double parentheses, e.g. ((foo == bar)) Which is a bit dumb, as any code along the lines of #define isBAR (foo == BAR) if (isBAR) {} will trigger the warning. This commit shuts clang up by putting in a harmless cast: #define isBAR cBOOL(foo == BAR) M cop.h M perl.h M regcomp.h M regen/warnings.pl M warnings.h ----------------------------------------------------------------------- Summary of changes: cop.h | 4 ++-- op.c | 8 +++++++- perl.h | 2 +- regcomp.c | 2 +- regcomp.h | 2 +- regen/warnings.pl | 4 ++-- regexec.c | 4 ++-- t/op/eval.t | 14 +++++++++++++- warnings.h | 4 ++-- 9 files changed, 31 insertions(+), 13 deletions(-) diff --git a/cop.h b/cop.h index dfb4a00..1795dc3 100644 --- a/cop.h +++ b/cop.h @@ -1055,8 +1055,8 @@ typedef struct stackinfo PERL_SI; } \ } STMT_END -#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) -#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling) +#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling) +#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling) diff --git a/op.c b/op.c index b1c480b..e58f711 100644 --- a/op.c +++ b/op.c @@ -2622,7 +2622,13 @@ S_mark_padname_lvalue(pTHX_ PADNAME *pn) PadnameLVALUE_on(pn); while (PadnameOUTER(pn) && PARENT_PAD_INDEX(pn)) { cv = CvOUTSIDE(cv); - assert(cv); + /* RT #127786: cv can be NULL due to an eval within the DB package + * called from an anon sub - anon subs don't have CvOUTSIDE() set + * unless they contain an eval, but calling eval within DB + * pretends the eval was done in the caller's scope. + */ + if (!cv) + break; assert(CvPADLIST(cv)); pn = PadlistNAMESARRAY(CvPADLIST(cv))[PARENT_PAD_INDEX(pn)]; diff --git a/perl.h b/perl.h index 2ee79c4..0468a1c 100644 --- a/perl.h +++ b/perl.h @@ -5275,7 +5275,7 @@ EXTCONST char *const PL_phase_names[]; /* Do not use this macro. It only exists for extensions that rely on PL_dirty * instead of using the newer PL_phase, which provides everything PL_dirty * provided, and more. */ -# define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT) +# define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT) # define PL_amagic_generation PL_na #endif /* !PERL_CORE */ diff --git a/regcomp.c b/regcomp.c index 2f46a24..63f6e9e 100644 --- a/regcomp.c +++ b/regcomp.c @@ -933,7 +933,7 @@ Perl_re_indentf(pTHX_ const char *fmt, U32 depth, ...) PerlIO *f= Perl_debug_log; PERL_ARGS_ASSERT_RE_INDENTF; va_start(ap, depth); - PerlIO_printf(f, "%*s", ( depth % 20 ) * 2, ""); + PerlIO_printf(f, "%*s", ( (int)depth % 20 ) * 2, ""); result = PerlIO_vprintf(f, fmt, ap); va_end(ap); return result; diff --git a/regcomp.h b/regcomp.h index c2e44aa..a8842a1 100644 --- a/regcomp.h +++ b/regcomp.h @@ -368,7 +368,7 @@ struct regnode_ssc { #define REG_MAGIC 0234 -#define SIZE_ONLY (RExC_emit == (regnode *) & RExC_emit_dummy) +#define SIZE_ONLY cBOOL(RExC_emit == (regnode *) & RExC_emit_dummy) #define PASS1 SIZE_ONLY #define PASS2 (! SIZE_ONLY) diff --git a/regen/warnings.pl b/regen/warnings.pl index d81a078..22c9c15 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -358,8 +358,8 @@ EOM print $warn <<'EOM'; -#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) -#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) +#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD) +#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) diff --git a/regexec.c b/regexec.c index f2e0164..29429b2 100644 --- a/regexec.c +++ b/regexec.c @@ -3640,7 +3640,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp) messages are inline with the regop output that created them. */ #define REPORT_CODE_OFF 29 -#define INDENT_CHARS(depth) ((depth) % 20) +#define INDENT_CHARS(depth) ((int)(depth) % 20) #ifdef DEBUGGING int Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...) @@ -3650,7 +3650,7 @@ Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...) PerlIO *f= Perl_debug_log; PERL_ARGS_ASSERT_RE_EXEC_INDENTF; va_start(ap, depth); - PerlIO_printf(f, "%*s|%4d| %*s", REPORT_CODE_OFF, "", depth, INDENT_CHARS(depth), "" ); + PerlIO_printf(f, "%*s|%4"UVuf"| %*s", REPORT_CODE_OFF, "", (UV)depth, INDENT_CHARS(depth), "" ); result = PerlIO_vprintf(f, fmt, ap); va_end(ap); return result; diff --git a/t/op/eval.t b/t/op/eval.t index 14f9565..7b9fb17 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan(tests => 133); +plan(tests => 134); eval 'pass();'; @@ -653,3 +653,15 @@ pass("eval in freed package does not crash"); eval q{$@ = 2}; ok(!$@, 'eval clearing $@'); } + +# RT #127786 +# this used to give an assertion failure + +{ + package DB { + sub f127786 { eval q/\$s/ } + } + my $s; + sub { $s; DB::f127786}->(); + pass("RT #127786"); +} diff --git a/warnings.h b/warnings.h index 4ab2d1d..337bef3 100644 --- a/warnings.h +++ b/warnings.h @@ -115,8 +115,8 @@ #define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125" #define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" -#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) -#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) +#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD) +#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) -- Perl5 Master Repository
