This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove null check from mg.c:magic_getvec
[perl5.git] / universal.c
index 97231e2..10fefe1 100644 (file)
@@ -348,6 +348,7 @@ XS(XS_UNIVERSAL_can)
     SV   *sv;
     SV   *rv;
     HV   *pkg = NULL;
+    GV   *iogv;
 
     if (items != 2)
        croak_xs_usage(cv, "object-ref, method");
@@ -373,6 +374,8 @@ XS(XS_UNIVERSAL_can)
     }
     else if (isGV_with_GP(sv) && GvIO(sv))
         pkg = SvSTASH(GvIO(sv));
+    else if ((iogv = gv_fetchsv_nomg(sv, 0, SVt_PVIO)) && GvIO(iogv))
+        pkg = SvSTASH(GvIO(iogv));
     else {
         pkg = gv_stashsv(sv, 0);
         if (!pkg)
@@ -909,20 +912,31 @@ XS(XS_Internals_SvREADONLY)       /* This is dangerous stuff. */
     sv = SvRV(svz);
 
     if (items == 1) {
-        if (SvREADONLY(sv) && !SvIsCOW(sv))
+        if (SvREADONLY(sv))
             XSRETURN_YES;
         else
             XSRETURN_NO;
     }
     else if (items == 2) {
        if (SvTRUE(ST(1))) {
+#ifdef PERL_OLD_COPY_ON_WRITE
            if (SvIsCOW(sv)) sv_force_normal(sv);
+#endif
            SvREADONLY_on(sv);
+           if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) {
+               /* for constant.pm; nobody else should be calling this
+                  on arrays anyway. */
+               SV **svp;
+               for (svp = AvARRAY(sv) + AvFILLp(sv)
+                  ; svp >= AvARRAY(sv)
+                  ; --svp)
+                   if (*svp) SvPADTMP_on(*svp);
+           }
            XSRETURN_YES;
        }
        else {
            /* I hope you really know what you are doing. */
-           if (!SvIsCOW(sv)) SvREADONLY_off(sv);
+           SvREADONLY_off(sv);
            XSRETURN_NO;
        }
     }