Remove null check from mg.c:magic_getvec

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index be06aca..10fefe1 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -165,7 +165,7 @@ Perl_sv_derived_from_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len,
     else {
         stash = gv_stashsv(sv, 0);
         if (!stash)
-            stash = gv_stashpv("UNIVERSAL", 0);
+            stash = gv_stashpvs("UNIVERSAL", 0);
     }
 
     return stash ? isa_lookup(stash, name, len, flags) : FALSE;
@@ -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");
@@ -356,8 +357,10 @@ XS(XS_UNIVERSAL_can)
 
     SvGETMAGIC(sv);
 
-    if (!SvOK(sv) || !(SvROK(sv) || SvNIOK(sv) || (SvPOK(sv) && SvCUR(sv))
-       ))
+    /* Reject undef and empty string.  Note that the string form takes
+       precedence here over the numeric form, as (!1)->foo treats the
+       invocant as the empty string, though it is a dualvar. */
+    if (!SvOK(sv) || (SvPOK(sv) && !SvCUR(sv)))
        XSRETURN_UNDEF;
 
     rv = &PL_sv_undef;
@@ -366,7 +369,13 @@ XS(XS_UNIVERSAL_can)
         sv = MUTABLE_SV(SvRV(sv));
         if (SvOBJECT(sv))
             pkg = SvSTASH(sv);
+        else if (isGV_with_GP(sv) && GvIO(sv))
+           pkg = SvSTASH(GvIO(sv));
     }
+    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)
@@ -490,7 +499,7 @@ XS(XS_version_new)
 {
     dVAR;
     dXSARGS;
-    if (items > 3)
+    if (items > 3 || items < 1)
        croak_xs_usage(cv, "class, version");
     SP -= items;
     {
@@ -903,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;
        }
     }
@@ -1086,44 +1106,6 @@ XS(XS_PerlIO_get_layers)
     XSRETURN(0);
 }
 
-XS(XS_Internals_hash_seed)
-{
-    dVAR;
-    /* Using dXSARGS would also have dITEM and dSP,
-     * which define 2 unused local variables.  */
-    dAXMARK;
-    PERL_UNUSED_ARG(cv);
-    PERL_UNUSED_VAR(mark);
-    XSRETURN_UV(PERL_HASH_SEED);
-}
-
-XS(XS_Internals_rehash_seed)
-{
-    dVAR;
-    /* Using dXSARGS would also have dITEM and dSP,
-     * which define 2 unused local variables.  */
-    dAXMARK;
-    PERL_UNUSED_ARG(cv);
-    PERL_UNUSED_VAR(mark);
-    XSRETURN_UV(PL_rehash_seed);
-}
-
-XS(XS_Internals_HvREHASH)      /* Subject to change  */
-{
-    dVAR;
-    dXSARGS;
-    PERL_UNUSED_ARG(cv);
-    if (SvROK(ST(0))) {
-       const HV * const hv = (const HV *) SvRV(ST(0));
-       if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
-           if (HvREHASH(hv))
-               XSRETURN_YES;
-           else
-               XSRETURN_NO;
-       }
-    }
-    Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
-}
 
 XS(XS_re_is_regexp)
 {
@@ -1257,11 +1239,11 @@ XS(XS_re_regexp_pattern)
     dXSARGS;
     REGEXP *re;
 
+    EXTEND(SP, 2);
+    SP -= items;
     if (items != 1)
        croak_xs_usage(cv, "sv");
 
-    SP -= items;
-
     /*
        Checks if a reference is a regex or not. If the parameter is
        not a ref, or is not the result of a qr// then returns false
@@ -1313,7 +1295,6 @@ XS(XS_re_regexp_pattern)
                                     (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
 
             /* return the pattern and the modifiers */
-            EXTEND(SP, 2);
             PUSHs(pattern);
             PUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
             XSRETURN(2);
@@ -1326,7 +1307,7 @@ XS(XS_re_regexp_pattern)
             pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
                                     (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
 #endif
-            XPUSHs(pattern);
+            PUSHs(pattern);
             XSRETURN(1);
         }
     } else {
@@ -1403,9 +1384,6 @@ const struct xsub_details details[] = {
     {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
     {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
     {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
-    {"Internals::hash_seed", XS_Internals_hash_seed, ""},
-    {"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
-    {"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
     {"re::is_regexp", XS_re_is_regexp, "$"},
     {"re::regname", XS_re_regname, ";$$"},
     {"re::regnames", XS_re_regnames, ";$"},