In makedef.pl, remove the skip for Perl_pidgone for not-PERL_USES_PL_PIDSTATUS.

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 488efa0..c891b54 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -21,7 +21,7 @@
  *
  * It is also used to store XS functions that need to be present in
  * miniperl for a lack of a better place to put them. It might be
- * clever to move them to seperate XS files which would then be pulled
+ * clever to move them to separate XS files which would then be pulled
  * in by some to-be-written build process.
  */
 
@@ -311,6 +311,7 @@ XS(XS_UNIVERSAL_VERSION)
     GV **gvp;
     GV *gv;
     SV *sv;
+    SV *ret;
     const char *undef;
     PERL_UNUSED_ARG(cv);
 
@@ -327,15 +328,12 @@ XS(XS_UNIVERSAL_VERSION)
     gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
 
     if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
-        SV * const nsv = sv_newmortal();
-        sv_setsv(nsv, sv);
-        sv = nsv;
-       if ( !sv_derived_from(sv, "version"))
-           upg_version(sv, FALSE);
+        ret = sv_newmortal();
+        sv_setsv(ret, sv);
         undef = NULL;
     }
     else {
-        sv = &PL_sv_undef;
+        sv = ret = &PL_sv_undef;
         undef = "(undef)";
     }
 
@@ -355,6 +353,9 @@ XS(XS_UNIVERSAL_VERSION)
             }
        }
 
+       if ( !sv_derived_from(sv, "version"))
+           upg_version(sv, FALSE);
+
        if ( !sv_derived_from(req, "version")) {
            /* req may very well be R/O, so create a new object */
            req = sv_2mortal( new_version(req) );
@@ -376,11 +377,7 @@ XS(XS_UNIVERSAL_VERSION)
 
     }
 
-    if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
-       ST(0) = sv_2mortal(vstringify(sv));
-    } else {
-       ST(0) = sv;
-    }
+    ST(0) = ret;
 
     XSRETURN(1);
 }
@@ -695,9 +692,10 @@ XS(XS_utf8_decode)
        croak_xs_usage(cv, "sv");
     else {
        SV * const sv = ST(0);
-       const bool RETVAL = sv_utf8_decode(sv);
+       bool RETVAL;
+       if (SvIsCOW(sv)) sv_force_normal(sv);
+       RETVAL = sv_utf8_decode(sv);
        ST(0) = boolSV(RETVAL);
-       sv_2mortal(ST(0));
     }
     XSRETURN(1);
 }
@@ -731,7 +729,6 @@ XS(XS_utf8_downgrade)
         const bool RETVAL = sv_utf8_downgrade(sv, failok);
 
        ST(0) = boolSV(RETVAL);
-       sv_2mortal(ST(0));
     }
     XSRETURN(1);
 }
@@ -777,19 +774,20 @@ XS(XS_Internals_SvREADONLY)       /* This is dangerous stuff. */
     sv = SvRV(svz);
 
     if (items == 1) {
-        if (SvREADONLY(sv))
+        if (SvREADONLY(sv) && !SvIsCOW(sv))
             XSRETURN_YES;
         else
             XSRETURN_NO;
     }
     else if (items == 2) {
        if (SvTRUE(ST(1))) {
+           if (SvIsCOW(sv)) sv_force_normal(sv);
            SvREADONLY_on(sv);
            XSRETURN_YES;
        }
        else {
            /* I hope you really know what you are doing. */
-           SvREADONLY_off(sv);
+           if (!SvIsCOW(sv)) SvREADONLY_off(sv);
            XSRETURN_NO;
        }
     }
@@ -1144,7 +1142,7 @@ XS(XS_re_regexp_pattern)
        Otherwise in list context it returns the pattern and the
        modifiers, in scalar context it returns the pattern just as it
        would if the qr// was stringified normally, regardless as
-       to the class of the variable and any strigification overloads
+       to the class of the variable and any stringification overloads
        on the object.
     */
 
@@ -1155,8 +1153,7 @@ XS(XS_re_regexp_pattern)
 
         if ( GIMME_V == G_ARRAY ) {
            STRLEN left = 0;
-           char reflags[sizeof(INT_PAT_MODS) + 1]; /* The +1 is for the charset
-                                                       modifier */
+           char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
             const char *fptr;
             char ch;
             U16 match_flags;
@@ -1164,17 +1161,18 @@ XS(XS_re_regexp_pattern)
             /*
                we are in list context so stringify
                the modifiers that apply. We ignore "negative
-               modifiers" in this scenario.
+               modifiers" in this scenario, and the default character set
             */
 
-            if (RX_EXTFLAGS(re) & RXf_PMf_LOCALE) {
-               reflags[left++] = LOCALE_PAT_MOD;
-           }
-           else if (RX_EXTFLAGS(re) & RXf_PMf_UNICODE) {
-               reflags[left++] = UNICODE_PAT_MOD;
+           if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
+               STRLEN len;
+               const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
+                                                               &len);
+               Copy(name, reflags + left, len, char);
+               left += len;
            }
             fptr = INT_PAT_MODS;
-            match_flags = (U16)((RX_EXTFLAGS(re) & PMf_COMPILETIME)
+            match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
                                     >> RXf_PMf_STD_PMMOD_SHIFT);
 
             while((ch = *fptr++)) {