adjust $DB::deep from 100 to 1000

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 8cc6e63..a72c072 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;
@@ -490,7 +490,7 @@ XS(XS_version_new)
 {
     dVAR;
     dXSARGS;
-    if (items > 3)
+    if (items > 3 || items < 1)
        croak_xs_usage(cv, "class, version");
     SP -= items;
     {
@@ -922,29 +922,29 @@ XS(XS_Internals_SvREADONLY)       /* This is dangerous stuff. */
     }
     XSRETURN_UNDEF; /* Can't happen. */
 }
-
 XS(XS_Internals_SvREFCNT)      /* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
     SV * const svz = ST(0);
     SV * sv;
+    U32 refcnt;
     PERL_UNUSED_ARG(cv);
 
     /* [perl #77776] - called as &foo() not foo() */
-    if (!SvROK(svz))
+    if ((items != 1 && items != 2) || !SvROK(svz))
         croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
 
     sv = SvRV(svz);
 
-    if (items == 1)
-        XSRETURN_UV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
-    else if (items == 2) {
          /* I hope you really know what you are doing. */
-        SvREFCNT(sv) = SvUV(ST(1)) + 1; /* we free one ref on exit */
-        XSRETURN_UV(SvREFCNT(sv) - 1);
-    }
-    XSRETURN_UNDEF; /* Can't happen. */
+    /* idea is for SvREFCNT(sv) to be accessed only once */
+    refcnt = items == 2 ?
+                /* we free one ref on exit */
+                (SvREFCNT(sv) = SvUV(ST(1)) + 1)
+                : SvREFCNT(sv);
+    XSRETURN_UV(refcnt - 1); /* Minus the ref created for us. */        
+
 }
 
 XS(XS_Internals_hv_clear_placehold)
@@ -1086,44 +1086,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 +1219,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 +1275,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 +1287,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 +1364,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, ";$"},