This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
perldelta for PL_amagic_generation removal
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 1e6addb..94b9281 100644 (file)
--- a/op.c
+++ b/op.c
@@ -428,11 +428,12 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
     if (len &&
        !(is_our ||
          isALPHA(name[1]) ||
-         ((flags & SVf_UTF8) && UTF8_IS_START(name[1])) ||
+         ((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) ||
          (name[1] == '_' && (*name == '$' || len > 2))))
     {
        /* name[2] is true if strlen(name) > 2  */
-       if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
+       if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
+        && (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
            yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in \"%s\"",
                              name[0], toCTRL(name[1]), (int)(len - 2), name + 2,
                              PL_parser->in_my == KEY_state ? "state" : "my"));
@@ -1774,7 +1775,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 
     switch (o->op_type) {
     case OP_UNDEF:
-       localize = 0;
        PL_modcount++;
        return o;
     case OP_STUB:
@@ -2059,10 +2059,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 STATIC bool
 S_scalar_mod_type(const OP *o, I32 type)
 {
-    assert(o || type != OP_SASSIGN);
-
     switch (type) {
+    case OP_POS:
     case OP_SASSIGN:
+       assert(o);
        if (o->op_type == OP_RV2GV)
            return FALSE;
        /* FALL THROUGH */
@@ -4688,9 +4688,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
            newSTATEOP(0, NULL, imop) ));
 
     if (use_version) {
-       HV * const hinthv = GvHV(PL_hintgv);
-       const bool hhoff = !hinthv || !(PL_hints & HINT_LOCALIZE_HH);
-
        /* Enable the
         * feature bundle that corresponds to the required version. */
        use_version = sv_2mortal(new_version(use_version));
@@ -4699,20 +4696,20 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
        /* If a version >= 5.11.0 is requested, strictures are on by default! */
        if (vcmp(use_version,
                 sv_2mortal(upg_version(newSVnv(5.011000), FALSE))) >= 0) {
-           if (hhoff || !hv_exists(hinthv, "strict/refs", 11))
+           if (!(PL_hints & HINT_EXPLICIT_STRICT_REFS))
                PL_hints |= HINT_STRICT_REFS;
-           if (hhoff || !hv_exists(hinthv, "strict/subs", 11))
+           if (!(PL_hints & HINT_EXPLICIT_STRICT_SUBS))
                PL_hints |= HINT_STRICT_SUBS;
-           if (hhoff || !hv_exists(hinthv, "strict/vars", 11))
+           if (!(PL_hints & HINT_EXPLICIT_STRICT_VARS))
                PL_hints |= HINT_STRICT_VARS;
        }
        /* otherwise they are off */
        else {
-           if (hhoff || !hv_exists(hinthv, "strict/refs", 11))
+           if (!(PL_hints & HINT_EXPLICIT_STRICT_REFS))
                PL_hints &= ~HINT_STRICT_REFS;
-           if (hhoff || !hv_exists(hinthv, "strict/subs", 11))
+           if (!(PL_hints & HINT_EXPLICIT_STRICT_SUBS))
                PL_hints &= ~HINT_STRICT_SUBS;
-           if (hhoff || !hv_exists(hinthv, "strict/vars", 11))
+           if (!(PL_hints & HINT_EXPLICIT_STRICT_VARS))
                PL_hints &= ~HINT_STRICT_VARS;
        }
     }
@@ -4861,10 +4858,10 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
     }
 
     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
-       doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+       doop = newUNOP(OP_ENTERSUB, OPf_STACKED,
                               op_append_elem(OP_LIST, term,
                                           scalar(newUNOP(OP_RV2CV, 0,
-                                                         newGVOP(OP_GV, 0, gv))))));
+                                                         newGVOP(OP_GV, 0, gv)))));
     }
     else {
        doop = newUNOP(OP_DOFILE, 0, scalar(term));
@@ -5716,6 +5713,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
        if (expr->op_type == OP_READLINE
            || expr->op_type == OP_READDIR
            || expr->op_type == OP_GLOB
+           || expr->op_type == OP_EACH || expr->op_type == OP_AEACH
            || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -5805,6 +5803,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
        if (expr->op_type == OP_READLINE
          || expr->op_type == OP_READDIR
          || expr->op_type == OP_GLOB
+        || expr->op_type == OP_EACH || expr->op_type == OP_AEACH
                     || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -6060,11 +6059,12 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
 
-    if (type != OP_GOTO || label->op_type == OP_CONST) {
+    if (type != OP_GOTO) {
        /* "last()" means "last" */
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
            o = newOP(type, OPf_SPECIAL);
        else {
+         const_label:
            o = newPVOP(type,
                         label->op_type == OP_CONST
                             ? SvUTF8(((SVOP*)label)->op_sv)
@@ -6084,6 +6084,12 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
        if (label->op_type == OP_ENTERSUB
                && !(label->op_flags & OPf_STACKED))
            label = newUNOP(OP_REFGEN, 0, op_lvalue(label, OP_REFGEN));
+       else if (label->op_type == OP_CONST) {
+           SV * const sv = ((SVOP *)label)->op_sv;
+           STRLEN l;
+           const char *s = SvPV_const(sv,l);
+           if (l == strlen(s)) goto const_label;
+       }
        o = newUNOP(type, OPf_STACKED, label);
     }
     PL_hints |= HINT_BLOCK_SCOPE;
@@ -7118,7 +7124,9 @@ CV *
 Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 {
     PERL_ARGS_ASSERT_NEWXS;
-    return newXS_flags(name, subaddr, filename, NULL, 0);
+    return newXS_len_flags(
+       name, name ? strlen(name) : 0, subaddr, filename, NULL, NULL, 0
+    );
 }
 
 #ifdef PERL_MAD
@@ -7584,11 +7592,10 @@ Perl_ck_eval(pTHX_ OP *o)
                           MUTABLE_SV(hv_copy_hints_hv(GvHV(PL_hintgv))));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;
-
-       if (!(o->op_private & OPpEVAL_BYTES)
+    }
+    if (!(o->op_private & OPpEVAL_BYTES)
         && FEATURE_UNIEVAL_IS_ENABLED)
            o->op_private |= OPpEVAL_UNICODE;
-    }
     return o;
 }
 
@@ -8138,17 +8145,10 @@ Perl_ck_glob(pTHX_ OP *o)
     else if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV))
          && GvCVu(gv) && GvIMPORTED_CV(gv)))
     {
-       gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
-    }
-
-#if !defined(PERL_EXTERNAL_GLOB)
-    if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
-       ENTER;
-       Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
-               newSVpvs("File::Glob"), NULL, NULL, NULL);
-       LEAVE;
+       GV * const * const gvp =
+           (GV **)hv_fetchs(PL_globalstash, "glob", FALSE);
+       gv = gvp ? *gvp : NULL;
     }
-#endif /* !PERL_EXTERNAL_GLOB */
 
     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
        /* convert
@@ -8172,11 +8172,19 @@ Perl_ck_glob(pTHX_ OP *o)
                    op_append_elem(OP_LIST, o,
                                scalar(newUNOP(OP_RV2CV, 0,
                                               newGVOP(OP_GV, 0, gv)))));
-       o = newUNOP(OP_NULL, 0, ck_subr(o));
+       o = newUNOP(OP_NULL, 0, o);
        o->op_targ = OP_GLOB; /* hint at what it used to be: eg in newWHILEOP */
        return o;
     }
     else o->op_flags &= ~OPf_SPECIAL;
+#if !defined(PERL_EXTERNAL_GLOB)
+    if (!PL_globhook) {
+       ENTER;
+       Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
+                              newSVpvs("File::Glob"), NULL, NULL, NULL);
+       LEAVE;
+    }
+#endif /* !PERL_EXTERNAL_GLOB */
     gv = newGVgen("main");
     gv_IOadd(gv);
 #ifndef PERL_EXTERNAL_GLOB
@@ -8679,11 +8687,11 @@ Perl_ck_require(pTHX_ OP *o)
 #ifndef PERL_MAD
        op_free(o);
 #endif
-       newop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+       newop = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST, kid,
                                            scalar(newUNOP(OP_RV2CV, 0,
                                                           newGVOP(OP_GV, 0,
-                                                                  gv))))));
+                                                                  gv)))));
        op_getmad(o,newop,'O');
        return newop;
     }
@@ -9614,6 +9622,7 @@ Perl_cv_set_call_checker(pTHX_ CV *cv, Perl_call_checker ckfun, SV *ckobj)
            SvREFCNT_inc_simple_void_NN(ckobj);
            callmg->mg_flags |= MGf_REFCOUNTED;
        }
+       callmg->mg_flags |= MGf_COPY;
     }
 }
 
@@ -10011,6 +10020,7 @@ Perl_rpeep(pTHX_ register OP *o)
                    firstcop->cop_line = secondcop->cop_line;
 #ifdef USE_ITHREADS
                    firstcop->cop_stashpv = secondcop->cop_stashpv;
+                   firstcop->cop_stashlen = secondcop->cop_stashlen;
                    firstcop->cop_file = secondcop->cop_file;
 #else
                    firstcop->cop_stash = secondcop->cop_stash;
Unnamed repository; edit this file 'description' to name the repository.