This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Call get-magic before rejecting non-refs in sv_bless
[perl5.git] / pp_sys.c
index 793de40..b837a1e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -899,6 +899,10 @@ PP(pp_tie)
                varsv = MUTABLE_SV(GvIOp(varsv));
                break;
            }
+           if (SvTYPE(varsv) == SVt_PVLV && LvTYPE(varsv) == 'y') {
+               vivify_defelem(varsv);
+               varsv = LvTARG(varsv);
+           }
            /* FALL THROUGH */
        default:
            methname = "TIESCALAR";
@@ -967,6 +971,9 @@ PP(pp_untie)
     if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHYES;
 
+    if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' &&
+       !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF;
+
     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
         if (obj) {
@@ -1005,6 +1012,9 @@ PP(pp_tied)
     if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHUNDEF;
 
+    if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' &&
+       !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF;
+
     if ((mg = SvTIED_mg(sv, how))) {
        PUSHs(SvTIED_obj(sv, mg));
        RETURN;
@@ -1102,10 +1112,11 @@ PP(pp_sselect)
        SvGETMAGIC(sv);
        if (!SvOK(sv))
            continue;
-       if (SvIsCOW(sv))
-               sv_force_normal_flags(sv, 0);
-       if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
+       if (SvREADONLY(sv)) {
+           if (!(SvPOK(sv) && SvCUR(sv) == 0))
                Perl_croak_no_modify();
+       }
+       else if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0);
        if (!SvPOK(sv)) {
            if (!SvPOKp(sv))
                Perl_ck_warner(aTHX_ packWARN(WARN_MISC),