Change isUTF8_CHAR to use macro, not expansion

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index c6e68d6..7d2314f 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -556,12 +556,18 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
     const MGVTBL* const vtbl = mg->mg_virtual;
     if (vtbl && vtbl->svt_free)
        vtbl->svt_free(aTHX_ sv, mg);
-    if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
+
+    if (mg->mg_type == PERL_MAGIC_collxfrm && mg->mg_len >= 0)
+        /* collate magic uses string len not buffer len, so
+         * free even with mg_len == 0 */
+        Safefree(mg->mg_ptr);
+    else if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
        if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8)
            Safefree(mg->mg_ptr);
        else if (mg->mg_len == HEf_SVKEY)
            SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
     }
+
     if (mg->mg_flags & MGf_REFCOUNTED)
        SvREFCNT_dec(mg->mg_obj);
     Safefree(mg);
@@ -594,7 +600,7 @@ Perl_mg_free(pTHX_ SV *sv)
 }
 
 /*
-=for apidoc Am|void|mg_free_type|SV *sv|int how
+=for apidoc mg_free_type
 
 Remove any magic of type C<how> from the SV C<sv>.  See L</sv_magic>.
 
@@ -818,9 +824,9 @@ S_fixup_errno_string(pTHX_ SV* sv)
          * avoid as many possible backward compatibility issues as possible, we
          * don't turn on the flag unless we have to.  So the flag stays off for
          * an entirely invariant string.  We assume that if the string looks
-         * like UTF-8, it really is UTF-8:  "text in any other encoding that
-         * uses bytes with the high bit set is extremely unlikely to pass a
-         * UTF-8 validity test"
+         * like UTF-8 in a single script, it really is UTF-8:  "text in any
+         * other encoding that uses bytes with the high bit set is extremely
+         * unlikely to pass a UTF-8 validity test"
          * (http://en.wikipedia.org/wiki/Charset_detection).  There is a
          * potential that we will get it wrong however, especially on short
          * error message text, so do an additional check. */
@@ -831,6 +837,11 @@ S_fixup_errno_string(pTHX_ SV* sv)
 
             &&  _is_cur_LC_category_utf8(LC_MESSAGES)
 
+#else   /* If can't check directly, at least can see if script is consistent,
+           under UTF-8, which gives us an extra measure of confidence. */
+
+            && isSCRIPT_RUN((const U8 *) SvPVX_const(sv), (U8 *) SvEND(sv),
+                            TRUE) /* Means assume UTF-8 */
 #endif
 
         ) {
@@ -840,7 +851,7 @@ S_fixup_errno_string(pTHX_ SV* sv)
 }
 
 /*
-=for apidoc Am|SV *|sv_string_from_errnum|int errnum|SV *tgtsv
+=for apidoc sv_string_from_errnum
 
 Generates the message string describing an OS error and returns it as
 an SV.  C<errnum> must be a value that C<errno> could take, identifying
@@ -1021,7 +1032,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        break;
 
     case '\006':               /* ^F */
-       sv_setiv(sv, (IV)PL_maxsysfd);
+        if (nextchar == '\0') {
+            sv_setiv(sv, (IV)PL_maxsysfd);
+        }
+        else if (strEQ(remaining, "EATURE_BITS")) {
+            sv_setuv(sv, PL_compiling.cop_features);
+        }
        break;
     case '\007':               /* ^GLOBAL_PHASE */
        if (strEQ(remaining, "LOBAL_PHASE")) {
@@ -1063,7 +1079,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
         sv_setiv(sv, (IV)PL_perldb);
        break;
     case '\023':               /* ^S */
-        {
+       if (nextchar == '\0') {
            if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING)
                SvOK_off(sv);
            else if (PL_in_eval)
@@ -1071,6 +1087,18 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            else
                sv_setiv(sv, 0);
        }
+       else if (strEQ(remaining, "AFE_LOCALES")) {
+
+#if ! defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)
+
+           sv_setuv(sv, (UV) 1);
+
+#else
+           sv_setuv(sv, (UV) 0);
+
+#endif
+
+        }
        break;
     case '\024':               /* ^T */
        if (nextchar == '\0') {
@@ -2510,6 +2538,15 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 }
 
 int
+Perl_magic_setnonelem(pTHX_ SV *sv, MAGIC *mg)
+{
+    PERL_ARGS_ASSERT_MAGIC_SETNONELEM;
+    PERL_UNUSED_ARG(mg);
+    sv_unmagic(sv, PERL_MAGIC_nonelem);
+    return 0;
+}
+
+int
 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS;
@@ -2808,7 +2845,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
             Perl_croak(aTHX_ "${^ENCODING} is no longer supported");
        break;
     case '\006':       /* ^F */
-       PL_maxsysfd = SvIV(sv);
+        if (mg->mg_ptr[1] == '\0') {
+            PL_maxsysfd = SvIV(sv);
+        }
+        else if (strEQ(mg->mg_ptr + 1, "EATURE_BITS")) {
+            PL_compiling.cop_features = SvUV(sv);
+        }
        break;
     case '\010':       /* ^H */
         {
@@ -2890,6 +2932,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
            if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
                if (!SvPOK(sv)) {
+                    if (!specialWARN(PL_compiling.cop_warnings))
+                        PerlMemShared_free(PL_compiling.cop_warnings);
                    PL_compiling.cop_warnings = pWARN_STD;
                    break;
                }
@@ -3044,7 +3088,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #else
 #   define PERL_VMS_BANG 0
 #endif
-#if defined(WIN32) && ! defined(UNDER_CE)
+#if defined(WIN32)
        SETERRNO(win32_get_errno(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0),
                 (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG);
 #else
@@ -3144,7 +3188,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        {
            const char *p = SvPV_const(sv, len);
             Groups_t *gary = NULL;
-            const char* endptr;
+            const char* p_end = p + len;
+            const char* endptr = p_end;
             UV uv;
 #ifdef _SC_NGROUPS_MAX
            int maxgrp = sysconf(_SC_NGROUPS_MAX);
@@ -3167,6 +3212,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                 if (endptr == NULL)
                     break;
                 p = endptr;
+                endptr = p_end;
                 while (isSPACE(*p))
                     ++p;
                 if (!*p)