In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/569ddb4a56f2ed0392373fc57373462af20917bd?hp=d9f6c008c9474fe901bbd0ed2ba0cde92775b1ee>
- Log ----------------------------------------------------------------- commit 569ddb4a56f2ed0392373fc57373462af20917bd Author: Father Chrysostomos <[email protected]> Date: Sat Nov 29 06:35:41 2014 -0800 scalar($#foo) needs to propagate lvalue context $ ./perl -Ilib -le 'for($#foo) { $_ = 3 } print $#foo' 3 $ ./perl -Ilib -le 'for(scalar $#foo) { $_ = 3 } print $#foo' -1 If I replace $#foo with $foo, I get the same results from both one-liners. In commit d408447cb6 (pre-5.16) I tried propagating lvalue context, but I did not take into account things like \scalar @array, which ended up being equivalent to \@array, instead of a returning a refer- ence to a scalar holding the length of the array. So I reverted it in 41b1a11c. See bug #106288. The $#foo example above, which I recently ran into, shows that we really do need to propagate lvalue context. (Come to think of it, it is just a variant of the test I added in d408447cb6.) But we need to be careful what kind we propagate. If scalar itself is in lvalue con- text, then, regardless of the type, we need to apply âentersubâ lvalue context to its argument. Also, to preserve existing behaviour as much as possible, this time scalar(...)= still dies. M op.c M t/op/array.t M t/op/substr.t commit 6d59e610a3f269be73ffea56a90d1cd7dc8bf2fd Author: Lukas Mai <[email protected]> Date: Sat Nov 29 12:17:05 2014 +0100 define and use STATIC_ASSERT_STMT for compile-time invariants M op.c M perl.h M pp.c M pp_hot.c M pp_sys.c M sv.c M toke.c commit e59642234eb8b658c16fed728636bfbbc49c4514 Author: Lukas Mai <[email protected]> Date: Sat Nov 29 12:37:50 2014 +0100 make more use of NOT_REACHED In particular, remove all instances of 'assert(0);'. M malloc.c M op.c M pad.c M perl.c M perlio.c M pp.c M pp_ctl.c M pp_hot.c M regcomp.c M regexec.c M universal.c M utf8.c M util.c commit b7bea5dafa8e0cb5ca70b7525fbd6b51eb723815 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 29 06:04:38 2014 -0800 [perl #123313] sub { f(); BEGIN{} } was void cx In v5.21.6-11-g34b5495 I accidentally put the last statement in a block in void context when followed by a sub declaration. scalarseq, and not just scalar, needs to know about the extra ex-cop kid. M op.c M t/op/context.t ----------------------------------------------------------------------- Summary of changes: malloc.c | 2 +- op.c | 18 +++++++++---- pad.c | 12 +++------ perl.c | 8 +++--- perl.h | 26 +++++++++++++++++- perlio.c | 4 +-- pp.c | 4 +-- pp_ctl.c | 10 +++---- pp_hot.c | 4 +-- pp_sys.c | 6 ++--- regcomp.c | 20 +++++++------- regexec.c | 85 +++++++++++++++++++++++++++------------------------------- sv.c | 8 +++--- t/op/array.t | 5 +++- t/op/context.t | 8 +++++- t/op/substr.t | 9 ++++++- toke.c | 2 +- universal.c | 2 +- utf8.c | 4 +-- util.c | 16 +++++------ 20 files changed, 145 insertions(+), 108 deletions(-) diff --git a/malloc.c b/malloc.c index 73a0480..51035fe 100644 --- a/malloc.c +++ b/malloc.c @@ -1056,7 +1056,7 @@ emergency_sbrk(MEM_SIZE size) do_croak: MALLOC_UNLOCK; emergency_sbrk_croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack)); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ return NULL; } diff --git a/op.c b/op.c index 4f7eaea..ec76efd 100644 --- a/op.c +++ b/op.c @@ -2099,9 +2099,13 @@ S_scalarseq(pTHX_ OP *o) if (type == OP_LINESEQ || type == OP_SCOPE || type == OP_LEAVE || type == OP_LEAVETRY) { - OP *kid; - for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid)) { - if (OP_HAS_SIBLING(kid)) { + OP *kid, *sib; + for (kid = cLISTOPo->op_first; kid; kid = sib) { + if ((sib = OP_SIBLING(kid)) + && ( OP_HAS_SIBLING(sib) || sib->op_type != OP_NULL + || ( sib->op_targ != OP_NEXTSTATE + && sib->op_targ != OP_DBSTATE ))) + { scalarvoid(kid); } } @@ -2943,6 +2947,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) break; } goto nomod; + + case OP_SCALAR: + op_lvalue(cUNOPo->op_first, OP_ENTERSUB); + goto nomod; } /* [20011101.069] File test operators interpret OPf_REF to mean that @@ -9623,7 +9631,7 @@ Perl_ck_rvconst(pTHX_ OP *o) SvREFCNT_dec(kid->op_sv); #ifdef USE_ITHREADS /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */ - assert (sizeof(PADOP) <= sizeof(SVOP)); + STATIC_ASSERT_STMT(sizeof(PADOP) <= sizeof(SVOP)); kPADOP->op_padix = pad_alloc(OP_GV, SVf_READONLY); SvREFCNT_dec(PAD_SVl(kPADOP->op_padix)); PAD_SETSV(kPADOP->op_padix, MUTABLE_SV(SvREFCNT_inc_simple_NN(gv))); @@ -11470,7 +11478,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) return op_convert_list(opnum,0,aop); } } - assert(0); + NOT_REACHED; return entersubop; } diff --git a/pad.c b/pad.c index a9581f8..eb89c1b 100644 --- a/pad.c +++ b/pad.c @@ -200,19 +200,13 @@ void Perl_set_padlist(CV * cv, PADLIST *padlist){ PERL_ARGS_ASSERT_SET_PADLIST; # if PTRSIZE == 8 - if((Size_t)padlist == UINT64_C(0xEFEFEFEFEFEFEFEF)){ - assert(0); - } + assert((Size_t)padlist != UINT64_C(0xEFEFEFEFEFEFEFEF)); # elif PTRSIZE == 4 - if((Size_t)padlist == UINT64_C(0xEFEFEFEF)){ - assert(0); - } + assert((Size_t)padlist != UINT64_C(0xEFEFEFEF)); # else # error unknown pointer size # endif - if(CvISXSUB(cv)){ - assert(0); - } + assert(!CvISXSUB(cv)); ((XPVCV*)MUTABLE_PTR(SvANY(cv)))->xcv_padlist_u.xcv_padlist = padlist; } #endif diff --git a/perl.c b/perl.c index eb875fc..b45f280 100644 --- a/perl.c +++ b/perl.c @@ -2420,7 +2420,7 @@ S_run_body(pTHX_ I32 oldscope) CALLRUNOPS(aTHX); } my_exit(0); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } /* @@ -2741,7 +2741,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) FREETMPS; JMPENV_POP; my_exit_jump(); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ case 3: if (PL_restartop) { PL_restartjmpenv = NULL; @@ -2850,7 +2850,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) FREETMPS; JMPENV_POP; my_exit_jump(); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ case 3: if (PL_restartop) { PL_restartjmpenv = NULL; @@ -4871,7 +4871,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) CopLINE_set(PL_curcop, oldline); JMPENV_POP; my_exit_jump(); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ case 3: if (PL_restartop) { PL_curcop = &PL_compiling; diff --git a/perl.h b/perl.h index f36157c..8a930de 100644 --- a/perl.h +++ b/perl.h @@ -3467,7 +3467,10 @@ typedef pthread_key_t perl_key; # define __attribute__warn_unused_result__ #endif -#if defined(DEBUGGING) && defined(I_ASSERT) +#ifdef I_ASSERT +# if !defined(DEBUGGING) && !defined(NDEBUG) +# define NDEBUG 1 +# endif # include <assert.h> #endif @@ -3498,6 +3501,27 @@ typedef pthread_key_t perl_key; /* placeholder */ #endif +#if defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L) +/* static_assert is a macro defined in <assert.h> in C11 or a compiler + builtin in C++11. +*/ +# define STATIC_ASSERT_GLOBAL(COND) static_assert(COND, #COND) +#else +/* We use a bit-field instead of an array because gcc accepts + 'typedef char x[n]' where n is not a compile-time constant. + We want to enforce constantness. +*/ +# define STATIC_ASSERT_2(COND, SUFFIX) \ + typedef struct { \ + unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \ + } _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL +# define STATIC_ASSERT_1(COND, SUFFIX) STATIC_ASSERT_2(COND, SUFFIX) +# define STATIC_ASSERT_GLOBAL(COND) STATIC_ASSERT_1(COND, __LINE__) +#endif +/* We need this wrapper even in C11 because 'case X: static_assert(...);' is an + error (static_assert is a declaration, and only statements can have labels). +*/ +#define STATIC_ASSERT_STMT(COND) do { STATIC_ASSERT_GLOBAL(COND); } while (0) #ifndef __has_builtin # define __has_builtin(x) 0 /* not a clang style compiler */ diff --git a/perlio.c b/perlio.c index a05e414..95b7482 100644 --- a/perlio.c +++ b/perlio.c @@ -2745,7 +2745,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) return -1; } - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ } SSize_t @@ -2774,7 +2774,7 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) return -1; } - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ } Off_t diff --git a/pp.c b/pp.c index 5abe647..6d575f7 100644 --- a/pp.c +++ b/pp.c @@ -2051,7 +2051,7 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right) return (leftuv > (UV)rightiv) - (leftuv < (UV)rightiv); } } - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } #endif { @@ -2956,7 +2956,7 @@ PP(pp_length) /* simplest case shortcut */ /* turn off SVf_UTF8 in tmp flags if HINT_BYTES on*/ U32 svflags = (SvFLAGS(sv) ^ (in_bytes << 26)) & (SVf_POK|SVs_GMG|SVf_UTF8); - assert(HINT_BYTES == 0x00000008 && SVf_UTF8 == 0x20000000 && (SVf_UTF8 == HINT_BYTES << 26)); + STATIC_ASSERT_STMT(HINT_BYTES == 0x00000008 && SVf_UTF8 == 0x20000000 && (SVf_UTF8 == HINT_BYTES << 26)); SETs(TARG); if(LIKELY(svflags == SVf_POK)) diff --git a/pp_ctl.c b/pp_ctl.c index 4f1c480..0b7a6ec 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -288,7 +288,7 @@ PP(pp_substcont) POPSUBST(cx); PERL_ASYNC_CHECK(); RETURNOP(pm->op_next); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } cx->sb_iters = saviters; } @@ -1676,13 +1676,13 @@ Perl_die_unwind(pTHX_ SV *msv) PL_restartjmpenv = restartjmpenv; PL_restartop = restartop; JMPENV_JUMP(3); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } } write_to_stderr(exceptsv); my_failure_exit(); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } PP(pp_xor) @@ -3237,7 +3237,7 @@ S_docatch(pTHX_ OP *o) JMPENV_POP; PL_op = oldop; JMPENV_JUMP(ret); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } JMPENV_POP; PL_op = oldop; @@ -3335,7 +3335,7 @@ S_try_yyparse(pTHX_ int gramtype) default: JMPENV_POP; JMPENV_JUMP(ret); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } JMPENV_POP; return ret; diff --git a/pp_hot.c b/pp_hot.c index 28eb987..48cc1cb 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -386,7 +386,7 @@ PP(pp_padrange) (base << (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)) | (count << SAVE_TIGHT_SHIFT) | SAVEt_CLEARPADRANGE); - assert(OPpPADRANGE_COUNTMASK + 1 == (1 <<OPpPADRANGE_COUNTSHIFT)); + STATIC_ASSERT_STMT(OPpPADRANGE_COUNTMASK + 1 == (1 << OPpPADRANGE_COUNTSHIFT)); assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == base); { dSS_ADD; @@ -1553,7 +1553,7 @@ PP(pp_match) LEAVE_SCOPE(oldsave); RETURN; } - /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ nope: if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) { diff --git a/pp_sys.c b/pp_sys.c index 0bc1aa1..8f6c753 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -534,9 +534,9 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, PERL_ARGS_ASSERT_TIED_METHOD; /* Ensure that our flag bits do not overlap. */ - assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0); - assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0); - assert((TIED_METHOD_SAY & G_WANT) == 0); + STATIC_ASSERT_STMT((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0); + STATIC_ASSERT_STMT((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0); + STATIC_ASSERT_STMT((TIED_METHOD_SAY & G_WANT) == 0); PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */ PUSHSTACKi(PERLSI_MAGIC); diff --git a/regcomp.c b/regcomp.c index 85a142e..3a9a554 100644 --- a/regcomp.c +++ b/regcomp.c @@ -5754,7 +5754,7 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVuf" RHS=%"UVuf"\n", } return final_minlen; } - /* not-reached */ + NOT_REACHED; } STATIC U32 @@ -8013,7 +8013,7 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) Perl_croak(aTHX_ "panic: bad flag %lx in reg_scan_name", (unsigned long) flags); } - assert(0); /* NOT REACHED */ + NOT_REACHED; /* NOT REACHED */ } return NULL; } @@ -9625,12 +9625,12 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) else { vFAIL3("Regexp modifiers \"%c\" and \"%c\" are mutually exclusive", has_charset_modifier, *(RExC_parse - 1)); } - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ neg_modifier: RExC_parse++; vFAIL2("Regexp modifier \"%c\" may not appear after the \"-\"", *(RExC_parse - 1)); - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ case ONCE_PAT_MOD: /* 'o' */ case GLOBAL_PAT_MOD: /* 'g' */ if (PASS2 && ckWARN(WARN_REGEXP)) { @@ -9703,7 +9703,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f("Sequence (%"UTF8f"...) not recognized", UTF8fARG(UTF, RExC_parse-seqstart, seqstart)); - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ } ++RExC_parse; @@ -9951,7 +9951,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart); - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ case '<': /* (?<...) */ if (*RExC_parse == '!') paren = ','; @@ -10084,7 +10084,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) if (RExC_parse == RExC_end || *RExC_parse != ')') vFAIL("Sequence (?&... not terminated"); goto gen_recurse_regop; - assert(0); /* NOT REACHED */ + /* NOT REACHED */ case '+': if (!(RExC_parse[0] >= '1' && RExC_parse[0] <= '9')) { RExC_parse++; @@ -10162,7 +10162,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) nextchar(pRExC_state); return ret; - assert(0); /* NOT REACHED */ + /* NOT REACHED */ case '?': /* (??...) */ is_logical = 1; @@ -10172,7 +10172,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) vFAIL2utf8f( "Sequence (%"UTF8f"...) not recognized", UTF8fARG(UTF, RExC_parse-seqstart, seqstart)); - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ } *flagp |= POSTPONED; paren = *RExC_parse++; @@ -10638,7 +10638,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) } else FAIL("Junk on end of regexp"); /* "Can't happen". */ - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } if (RExC_in_lookbehind) { diff --git a/regexec.c b/regexec.c index e74ca18..b7b1d29 100644 --- a/regexec.c +++ b/regexec.c @@ -485,7 +485,7 @@ S_isFOO_lc(pTHX_ const U8 classnum, const U8 character) Perl_croak(aTHX_ "panic: isFOO_lc() has an unexpected character class '%d'", classnum); } - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ return FALSE; } @@ -2047,7 +2047,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, default: Perl_croak(aTHX_ "panic: find_byclass() node %d='%s' has an unexpected character class '%d'", OP(c), PL_reg_name[OP(c)], classnum); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } } break; @@ -3844,7 +3844,7 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, default: Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node)); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } } } @@ -4037,14 +4037,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) rex->offs[0].start = locinput - reginfo->strbeg; PUSH_STATE_GOTO(KEEPS_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; case KEEPS_next_fail: /* rollback the start point change */ rex->offs[0].start = st->u.keeper.val; sayNO_SILENT; /* NOTREACHED */ - assert(0); + NOT_REACHED; case MEOL: /* /..$/m */ if (!NEXTCHR_IS_EOS && nextchr != '\n') @@ -4094,7 +4094,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) ); sayNO_SILENT; /* NOTREACHED */ - assert(0); + NOT_REACHED; } /* FALLTHROUGH */ case TRIE: /* (ab|cd) */ @@ -4282,7 +4282,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) goto trie_first_try; /* jump into the fail handler */ }} /* NOTREACHED */ - assert(0); + NOT_REACHED; case TRIE_next_fail: /* we failed - try next alternative */ { @@ -4397,7 +4397,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (ST.accepted > 1 || has_cutgroup) { PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc); /* NOTREACHED */ - assert(0); + NOT_REACHED; } /* only one choice left - just continue */ DEBUG_EXECUTE_r({ @@ -4422,7 +4422,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) locinput = (char*)uc; continue; /* execute rest of RE */ /* NOTREACHED */ - assert(0); } #undef ST @@ -5227,9 +5226,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* and then jump to the code we share with EVAL */ goto eval_recurse_doit; - /* NOTREACHED */ - assert(0); case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */ if (cur_eval && cur_eval->locinput==locinput) { @@ -5511,7 +5508,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* now continue from first node in postoned RE */ PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; } case EVAL_AB: /* cleanup after a successful (??{A})B */ @@ -5771,21 +5768,21 @@ NULL PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next), locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; } case CURLYX_end: /* just finished matching all of A*B */ cur_curlyx = ST.prev_curlyx; sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; case CURLYX_end_fail: /* just failed to match all of A*B */ regcpblow(ST.cp); cur_curlyx = ST.prev_curlyx; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; #undef ST @@ -5824,7 +5821,7 @@ NULL PUSH_STATE_GOTO(WHILEM_A_pre, A, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; } /* If degenerate A matches "", assume A done. */ @@ -5937,7 +5934,7 @@ NULL PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; } /* Prefer A over B for maximal matching. */ @@ -5949,19 +5946,19 @@ NULL REGCP_SET(ST.lastcp); PUSH_STATE_GOTO(WHILEM_A_max, A, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; } goto do_whilem_B_max; } /* NOTREACHED */ - assert(0); + NOT_REACHED; case WHILEM_B_min: /* just matched B in a minimal match */ case WHILEM_B_max: /* just matched B in a maximal match */ cur_curlyx = ST.save_curlyx; sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; case WHILEM_B_max_fail: /* just failed to match B in a maximal match */ cur_curlyx = ST.save_curlyx; @@ -5969,7 +5966,7 @@ NULL cur_curlyx->u.curlyx.count--; CACHEsayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; case WHILEM_A_min_fail: /* just failed to match A in a minimal match */ /* FALLTHROUGH */ @@ -5980,7 +5977,7 @@ NULL cur_curlyx->u.curlyx.count--; CACHEsayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; case WHILEM_A_max_fail: /* just failed to match A in a maximal match */ REGCP_UNWIND(ST.lastcp); @@ -6007,7 +6004,7 @@ NULL PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; case WHILEM_B_min_fail: /* just failed to match B in a minimal match */ cur_curlyx = ST.save_curlyx; @@ -6042,7 +6039,7 @@ NULL /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; #undef ST #define ST st->u.branch @@ -6068,14 +6065,14 @@ NULL PUSH_STATE_GOTO(BRANCH_next, scan, locinput); } /* NOTREACHED */ - assert(0); + NOT_REACHED; case CUTGROUP: /* /(*THEN)/ */ sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL : MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); PUSH_STATE_GOTO(CUTGROUP_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; case CUTGROUP_next_fail: do_cutgroup = 1; @@ -6084,12 +6081,12 @@ NULL sv_commit = st->u.mark.mark_name; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; case BRANCH_next: sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; case BRANCH_next_fail: /* that branch failed; try the next, if any */ if (do_cutgroup) { @@ -6112,7 +6109,6 @@ NULL } continue; /* execute next BRANCH[J] op */ /* NOTREACHED */ - assert(0); case MINMOD: /* next op will be non-greedy, e.g. A*? */ minmod = 1; @@ -6157,7 +6153,7 @@ NULL curlym_do_A: /* execute the A in /A{m,n}B/ */ PUSH_YES_STATE_GOTO(CURLYM_A, ST.A, locinput); /* match A */ /* NOTREACHED */ - assert(0); + NOT_REACHED; case CURLYM_A: /* we've just matched an A */ ST.count++; @@ -6294,7 +6290,7 @@ NULL PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */ /* NOTREACHED */ - assert(0); + NOT_REACHED; case CURLYM_B_fail: /* just failed to match a B */ REGCP_UNWIND(ST.cp); @@ -6473,7 +6469,7 @@ NULL goto curly_try_B_max; } /* NOTREACHED */ - assert(0); + NOT_REACHED; case CURLY_B_min_known_fail: /* failed to find B in a non-greedy match where c1,c2 valid */ @@ -6549,7 +6545,7 @@ NULL PUSH_STATE_GOTO(CURLY_B_min_known, ST.B, locinput); } /* NOTREACHED */ - assert(0); + NOT_REACHED; case CURLY_B_min_fail: /* failed to find B in a non-greedy match where c1,c2 invalid */ @@ -6582,7 +6578,7 @@ NULL } sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; curly_try_B_max: /* a successful greedy match: now try to match B */ @@ -6613,7 +6609,7 @@ NULL CURLY_SETPAREN(ST.paren, ST.count); PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; } } /* FALLTHROUGH */ @@ -6733,7 +6729,7 @@ NULL /* execute body of (?...A) */ PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)), newstart); /* NOTREACHED */ - assert(0); + NOT_REACHED; } case IFMATCH_A_fail: /* body of (?...A) failed */ @@ -6774,7 +6770,7 @@ NULL sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); PUSH_STATE_GOTO(COMMIT_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; case COMMIT_next_fail: no_final = 1; @@ -6783,7 +6779,7 @@ NULL case OPFAIL: /* (*FAIL) */ sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; #define ST st->u.mark case MARKPOINT: /* (*MARK:foo) */ @@ -6794,13 +6790,13 @@ NULL ST.mark_loc = locinput; PUSH_YES_STATE_GOTO(MARKPOINT_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; case MARKPOINT_next: mark_state = ST.prev_mark; sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; case MARKPOINT_next_fail: if (popmark && sv_eq(ST.mark_name,popmark)) @@ -6822,7 +6818,7 @@ NULL mark_state->u.mark.mark_name : NULL; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; case SKIP: /* (*SKIP) */ if (scan->flags) { @@ -6868,7 +6864,7 @@ NULL no_final = 1; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; #undef ST case LNBREAK: /* \R */ @@ -6903,7 +6899,6 @@ NULL scan = next; /* prepare to execute the next op and ... */ continue; /* ... jump back to the top, reusing st */ /* NOTREACHED */ - assert(0); push_yes_state: /* push a state that backtracks on success */ @@ -6947,7 +6942,6 @@ NULL st = newst; continue; /* NOTREACHED */ - assert(0); } } @@ -6958,6 +6952,7 @@ NULL Perl_croak(aTHX_ "corrupted regexp pointers"); /* NOTREACHED */ sayNO; + NOT_REACHED; yes: if (yes_state) { @@ -7584,7 +7579,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, default: Perl_croak(aTHX_ "panic: regrepeat() called with unrecognized node type %d='%s'", OP(p), PL_reg_name[OP(p)]); /* NOTREACHED */ - assert(0); + NOT_REACHED; } diff --git a/sv.c b/sv.c index 40b614e..3cbcbf8 100644 --- a/sv.c +++ b/sv.c @@ -1320,8 +1320,8 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) break; case SVt_PV: assert(new_type > SVt_PV); - assert(SVt_IV < SVt_PV); - assert(SVt_NV < SVt_PV); + STATIC_ASSERT_STMT(SVt_IV < SVt_PV); + STATIC_ASSERT_STMT(SVt_NV < SVt_PV); break; case SVt_PVIV: break; @@ -4311,7 +4311,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) /* We're starting from SVt_NULL, so provided that's * actual 0, we don't have to unset any SV type flags * to promote to SVt_IV. */ - assert(SVt_NULL == 0); + STATIC_ASSERT_STMT(SVt_NULL == 0); SET_SVANY_FOR_BODYLESS_IV(dstr); SvFLAGS(dstr) |= SVt_IV; break; @@ -9366,7 +9366,7 @@ Perl_newSViv(pTHX_ const IV i) /* We're starting from SVt_FIRST, so provided that's * actual 0, we don't have to unset any SV type flags * to promote to SVt_IV. */ - assert(SVt_FIRST == 0); + STATIC_ASSERT_STMT(SVt_FIRST == 0); SET_SVANY_FOR_BODYLESS_IV(sv); SvFLAGS(sv) |= SVt_IV; diff --git a/t/op/array.t b/t/op/array.t index 30a1e1d..7239d48 100644 --- a/t/op/array.t +++ b/t/op/array.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan (171); +plan (172); # # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them @@ -546,4 +546,7 @@ pass "no assertion failure after assigning ref to arylen when ary is gone"; is "@ary", 'b a', 'aelemfast with the same array on both sides of list assignment'; +for(scalar $#foo) { $_ = 3 } +is $#foo, 3, 'assigning to arylen aliased in foreach(scalar $#arylen)'; + "We're included by lib/Tie/Array/std.t so we need to return something true"; diff --git a/t/op/context.t b/t/op/context.t index 5272b7a..41ee84b 100644 --- a/t/op/context.t +++ b/t/op/context.t @@ -6,7 +6,7 @@ BEGIN { } require "./test.pl"; -plan( tests => 7 ); +plan( tests => 8 ); sub foo { $a='abcd'; @@ -25,3 +25,9 @@ my $after = curr_test(); cmp_ok($after-$before,'==',1,'foo called once') or diag("nr tests: before=$before, after=$after"); + +sub context { + $cx = qw[void scalar list][wantarray + defined wantarray]; +} +$_ = sub { context(); BEGIN { } }->(); +is($cx, 'scalar', 'context of { foo(); BEGIN {} }'); diff --git a/t/op/substr.t b/t/op/substr.t index 801895d..71e9e89 100644 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -22,7 +22,7 @@ $SIG{__WARN__} = sub { } }; -plan(387); +plan(388); run_tests() unless caller; @@ -683,6 +683,13 @@ is($x, "\x{100}\x{200}\xFFb"); } } +# Also part of perl #24346; scalar(substr...) should not affect lvalueness +{ + my $str = "abcdef"; + sub { $_[0] = 'dea' }->( scalar substr $str, 3, 2 ); + is $str, 'abcdeaf', 'scalar does not affect lvalueness of substr'; +} + # [perl #24200] string corruption with lvalue sub { diff --git a/toke.c b/toke.c index 236acd5..2433f1f 100644 --- a/toke.c +++ b/toke.c @@ -730,7 +730,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) parser->bufend = parser->bufptr + SvCUR(parser->linestr); parser->last_lop = parser->last_uni = NULL; - assert(FITS_IN_8_BITS(LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES + STATIC_ASSERT_STMT(FITS_IN_8_BITS(LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES |LEX_DONT_CLOSE_RSFP)); parser->lex_flags = (U8) (flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES |LEX_DONT_CLOSE_RSFP)); diff --git a/universal.c b/universal.c index e1e1a0b..7e3e93b 100644 --- a/universal.c +++ b/universal.c @@ -995,7 +995,7 @@ XS(XS_re_regexp_pattern) XSRETURN_NO; } } - /* NOT-REACHED */ + NOT_REACHED; /* NOT-REACHED */ } #include "vutil.h" diff --git a/utf8.c b/utf8.c index f7a4976..f328372 100644 --- a/utf8.c +++ b/utf8.c @@ -140,7 +140,7 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) { #ifdef EBCDIC Perl_die(aTHX_ "Can't represent character for Ox%"UVXf" on this platform", uv); - assert(0); + NOT_REACHED; #endif return NULL; } @@ -1430,7 +1430,7 @@ Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_ return 'S'; default: Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect '%c' to map to '%c'", c, LATIN_SMALL_LETTER_Y_WITH_DIAERESIS); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } } diff --git a/util.c b/util.c index d1a13a2..056f026 100644 --- a/util.c +++ b/util.c @@ -184,7 +184,7 @@ Perl_safesysmalloc(MEM_SIZE size) croak_no_mem(); } } - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ } /* paranoid version of system's realloc() */ @@ -305,7 +305,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) croak_no_mem(); } } - /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ } /* safe version of system's free() */ @@ -1560,7 +1560,7 @@ Perl_die_sv(pTHX_ SV *baseex) { PERL_ARGS_ASSERT_DIE_SV; croak_sv(baseex); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ NORETURN_FUNCTION_END; } #ifdef _MSC_VER @@ -1592,7 +1592,7 @@ Perl_die_nocontext(const char* pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ va_end(args); NORETURN_FUNCTION_END; } @@ -1614,7 +1614,7 @@ Perl_die(pTHX_ const char* pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ va_end(args); NORETURN_FUNCTION_END; } @@ -1717,7 +1717,7 @@ Perl_croak_nocontext(const char *pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ va_end(args); } #endif /* PERL_IMPLICIT_CONTEXT */ @@ -1728,7 +1728,7 @@ Perl_croak(pTHX_ const char *pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ va_end(args); } @@ -5665,7 +5665,7 @@ Perl_my_dirfd(DIR * dir) { return dir->dd_fd; #else Perl_croak_nocontext(PL_no_func, "dirfd"); - assert(0); /* NOT REACHED */ + NOT_REACHED; /* NOT REACHED */ return 0; #endif } -- Perl5 Master Repository
