pp_ctl.c: Use isCNTRL instead of hard-coded mask

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 805f376..847de55 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -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;
        }
     }
@@ -1022,9 +1042,9 @@ XS(XS_PerlIO_get_layers)
        if (gv && (io = GvIO(gv))) {
             AV* const av = PerlIO_get_layers(aTHX_ input ?
                                        IoIFP(io) : IoOFP(io));
-            I32 i;
-            const I32 last = av_len(av);
-            I32 nitem = 0;
+            SSize_t i;
+            const SSize_t last = av_len(av);
+            SSize_t nitem = 0;
             
             for (i = last; i >= 0; i -= 3) {
                  SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
@@ -1166,8 +1186,8 @@ XS(XS_re_regnames)
     U32 flags;
     SV *ret;
     AV *av;
-    I32 length;
-    I32 i;
+    SSize_t length;
+    SSize_t i;
     SV **entry;
 
     if (items > 1)
@@ -1219,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
@@ -1275,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);
@@ -1288,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 {