This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ck_glob() - add a little code comment
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 53641c7..ba9e2e2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -910,7 +910,8 @@ S_scalarboolean(pTHX_ OP *o)
 
     PERL_ARGS_ASSERT_SCALARBOOLEAN;
 
-    if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
+    if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST
+     && !(cBINOPo->op_first->op_flags & OPf_SPECIAL)) {
        if (ckWARN(WARN_SYNTAX)) {
            const line_t oldline = CopLINE(PL_curcop);
 
@@ -2142,6 +2143,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
 {
     dVAR;
     I32 type;
+    const bool stately = PL_parser && PL_parser->in_my == KEY_state;
 
     PERL_ARGS_ASSERT_MY_KID;
 
@@ -2212,7 +2214,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     }
     o->op_flags |= OPf_MOD;
     o->op_private |= OPpLVAL_INTRO;
-    if (PL_parser->in_my == KEY_state)
+    if (stately)
        o->op_private |= OPpPAD_STATE;
     return o;
 }
@@ -2428,7 +2430,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
 /*
 =head1 Compile-time scope hooks
 
-=for apidoc Ao||blockhook_register
+=for apidoc Aox||blockhook_register
 
 Register a set of hooks to be called when the Perl lexical scope changes
 at compile time. See L<perlguts/"Compile-time scope hooks">.
@@ -3929,7 +3931,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
            rcop->op_targ = pad_alloc(rcop->op_type, SVs_PADTMP);
 
        /* /$x/ may cause an eval, since $x might be qr/(?{..})/  */
-       PL_cv_has_eval = 1;
+       if (PL_hints & HINT_RE_EVAL) PL_cv_has_eval = 1;
 
        /* establish postfix order */
        if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
@@ -6023,7 +6025,9 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
        if (sv && o->op_next == o)
            return sv;
        if (o->op_next != o) {
-           if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
+           if (type == OP_NEXTSTATE
+            || (type == OP_NULL && !(o->op_flags & OPf_KIDS))
+            || type == OP_PUSHMARK)
                continue;
            if (type == OP_DBSTATE)
                continue;
@@ -7634,7 +7638,7 @@ Perl_ck_glob(pTHX_ OP *o)
 
     o = ck_fun(o);
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
-       op_append_elem(OP_GLOB, o, newDEFSVOP());
+       op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
 
     if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV))
          && GvCVu(gv) && GvIMPORTED_CV(gv)))
@@ -7934,7 +7938,13 @@ Perl_ck_sassign(pTHX_ OP *o)
     }
     if (kid->op_sibling) {
        OP *kkid = kid->op_sibling;
-       if (kkid->op_type == OP_PADSV
+       /* For state variable assignment, kkid is a list op whose op_last
+          is a padsv. */
+       if ((kkid->op_type == OP_PADSV ||
+            (kkid->op_type == OP_LIST &&
+             (kkid = cLISTOPx(kkid)->op_last)->op_type == OP_PADSV
+            )
+           )
                && (kkid->op_private & OPpLVAL_INTRO)
                && SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) {
            const PADOFFSET target = kkid->op_targ;
@@ -9661,7 +9671,8 @@ Perl_rpeep(pTHX_ register OP *o)
 
            /* Make the CONST have a shared SV */
            svp = cSVOPx_svp(((BINOP*)o)->op_last);
-           if (!SvFAKE(sv = *svp) || !SvREADONLY(sv)) {
+           if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv))
+            && SvTYPE(sv) < SVt_PVMG && !SvROK(sv)) {
                key = SvPV_const(sv, keylen);
                lexname = newSVpvn_share(key,
                                         SvUTF8(sv) ? -(I32)keylen : (I32)keylen,