This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Note that certain flags are documented
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index e088e5c..46d6b25 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2086,10 +2086,6 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv
 
 /* If numtype is infnan, set the NV of the sv accordingly.
  * If numtype is anything else, try setting the NV using Atof(PV). */
 
 /* If numtype is infnan, set the NV of the sv accordingly.
  * If numtype is anything else, try setting the NV using Atof(PV). */
-#ifdef USING_MSVC6
-#  pragma warning(push)
-#  pragma warning(disable:4756;disable:4056)
-#endif
 static void
 S_sv_setnv(pTHX_ SV* sv, int numtype)
 {
 static void
 S_sv_setnv(pTHX_ SV* sv, int numtype)
 {
@@ -2118,9 +2114,6 @@ S_sv_setnv(pTHX_ SV* sv, int numtype)
             SvPOK_on(sv); /* PV is okay, though. */
     }
 }
             SvPOK_on(sv); /* PV is okay, though. */
     }
 }
-#ifdef USING_MSVC6
-#  pragma warning(pop)
-#endif
 
 STATIC bool
 S_sv_2iuv_common(pTHX_ SV *const sv)
 
 STATIC bool
 S_sv_2iuv_common(pTHX_ SV *const sv)
@@ -5496,6 +5489,10 @@ C<mg_set> on C<dsv> afterwards if appropriate.
 C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
 in terms of this function.
 
 C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
 in terms of this function.
 
+=for apidoc Amnh||SV_CATUTF8
+=for apidoc Amnh||SV_CATBYTES
+=for apidoc Amnh||SV_SMAGIC
+
 =cut
 */
 
 =cut
 */
 
@@ -6661,9 +6658,6 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                sv_del_backref(MUTABLE_SV(stash), sv);
            goto freescalar;
        case SVt_PVHV:
                sv_del_backref(MUTABLE_SV(stash), sv);
            goto freescalar;
        case SVt_PVHV:
-           if (PL_last_swash_hv == (const HV *)sv) {
-               PL_last_swash_hv = NULL;
-           }
            if (HvTOTALKEYS((HV*)sv) > 0) {
                const HEK *hek;
                /* this statement should match the one at the beginning of
            if (HvTOTALKEYS((HV*)sv) > 0) {
                const HEK *hek;
                /* this statement should match the one at the beginning of
@@ -10311,8 +10305,12 @@ Perl_sv_isobject(pTHX_ SV *sv)
 =for apidoc sv_isa
 
 Returns a boolean indicating whether the SV is blessed into the specified
 =for apidoc sv_isa
 
 Returns a boolean indicating whether the SV is blessed into the specified
-class.  This does not check for subtypes; use C<sv_derived_from> to verify
-an inheritance relationship.
+class.
+
+This does not check for subtypes or method overloading. Use C<sv_isa_sv> to
+verify an inheritance relationship in the same way as the C<isa> operator by
+respecting any C<isa()> method overloading; or C<sv_derived_from_sv> to test
+directly on the actual object type.
 
 =cut
 */
 
 =cut
 */
@@ -12198,15 +12196,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
             /* the asterisk specified a width */
             {
                 int i = 0;
             /* the asterisk specified a width */
             {
                 int i = 0;
-                SV *sv = NULL;
+                SV *width_sv = NULL;
                 if (args)
                     i = va_arg(*args, int);
                 else {
                     ix = ix ? ix - 1 : svix++;
                 if (args)
                     i = va_arg(*args, int);
                 else {
                     ix = ix ? ix - 1 : svix++;
-                    sv = (ix < sv_count) ? svargs[ix]
+                    width_sv = (ix < sv_count) ? svargs[ix]
                                       : (arg_missing = TRUE, (SV*)NULL);
                 }
                                       : (arg_missing = TRUE, (SV*)NULL);
                 }
-                width = S_sprintf_arg_num_val(aTHX_ args, i, sv, &left);
+                width = S_sprintf_arg_num_val(aTHX_ args, i, width_sv, &left);
             }
         }
        else if (*q == 'v') {
             }
         }
        else if (*q == 'v') {
@@ -12253,17 +12251,17 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
                 {
                     int i = 0;
 
                 {
                     int i = 0;
-                    SV *sv = NULL;
+                    SV *width_sv = NULL;
                     bool neg = FALSE;
 
                     if (args)
                         i = va_arg(*args, int);
                     else {
                         ix = ix ? ix - 1 : svix++;
                     bool neg = FALSE;
 
                     if (args)
                         i = va_arg(*args, int);
                     else {
                         ix = ix ? ix - 1 : svix++;
-                        sv = (ix < sv_count) ? svargs[ix]
+                        width_sv = (ix < sv_count) ? svargs[ix]
                                           : (arg_missing = TRUE, (SV*)NULL);
                     }
                                           : (arg_missing = TRUE, (SV*)NULL);
                     }
-                    precis = S_sprintf_arg_num_val(aTHX_ args, i, sv, &neg);
+                    precis = S_sprintf_arg_num_val(aTHX_ args, i, width_sv, &neg);
                     has_precis = !neg;
                     /* ignore negative precision */
                     if (!has_precis)
                     has_precis = !neg;
                     /* ignore negative precision */
                     if (!has_precis)
@@ -13205,20 +13203,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
 #ifdef USE_QUADMATH
                 {
                 GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
 #ifdef USE_QUADMATH
                 {
-                    const char* qfmt = quadmath_format_single(ptr);
-                    if (!qfmt)
+                    if (!quadmath_format_valid(ptr))
                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);
                     WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
                         elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);
                     WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
                         elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
-                                                 qfmt, nv);
+                                                 ptr, nv);
                     );
                     if ((IV)elen == -1) {
                     );
                     if ((IV)elen == -1) {
-                        if (qfmt != ptr)
-                            SAVEFREEPV(qfmt);
-                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", ptr);
                     }
                     }
-                    if (qfmt != ptr)
-                        Safefree(qfmt);
                 }
 #elif defined(HAS_LONG_DOUBLE)
                 WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
                 }
 #elif defined(HAS_LONG_DOUBLE)
                 WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
@@ -13291,7 +13284,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         Perl_croak_nocontext(
                             "Missing argument for %%n in %s",
                                 PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
                         Perl_croak_nocontext(
                             "Missing argument for %%n in %s",
                                 PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
-                    sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)len);
+                    sv_setuv_mg(argsv, has_utf8
+                        ? (UV)utf8_length((U8*)SvPVX(sv), (U8*)SvEND(sv))
+                        : (UV)len);
                 }
                 goto done_valid_conversion;
             }
                 }
                 goto done_valid_conversion;
             }
@@ -13450,6 +13445,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
     }
 
                PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
     }
 
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
+        /* while we shouldn't set the cache, it may have been previously
+           set in the caller, so clear it */
+        MAGIC *mg = mg_find(sv, PERL_MAGIC_utf8);
+        if (mg)
+            magic_setutf8(sv,mg); /* clear UTF8 cache */
+    }
     SvTAINT(sv);
 }
 
     SvTAINT(sv);
 }
 
@@ -14690,6 +14692,7 @@ Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
 
     nsi->si_stack      = av_dup_inc(si->si_stack, param);
     nsi->si_cxix       = si->si_cxix;
 
     nsi->si_stack      = av_dup_inc(si->si_stack, param);
     nsi->si_cxix       = si->si_cxix;
+    nsi->si_cxsubix    = si->si_cxsubix;
     nsi->si_cxmax      = si->si_cxmax;
     nsi->si_cxstack    = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax, param);
     nsi->si_type       = si->si_type;
     nsi->si_cxmax      = si->si_cxmax;
     nsi->si_cxstack    = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax, param);
     nsi->si_type       = si->si_type;
@@ -15322,6 +15325,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origalen                = proto_perl->Iorigalen;
 
     PL_sighandlerp     = proto_perl->Isighandlerp;
     PL_origalen                = proto_perl->Iorigalen;
 
     PL_sighandlerp     = proto_perl->Isighandlerp;
+    PL_sighandler1p    = proto_perl->Isighandler1p;
+    PL_sighandler3p    = proto_perl->Isighandler3p;
 
     PL_runops          = proto_perl->Irunops;
 
 
     PL_runops          = proto_perl->Irunops;
 
@@ -15384,13 +15389,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_globhook                = proto_perl->Iglobhook;
 
 
     PL_globhook                = proto_perl->Iglobhook;
 
-    /* swatch cache */
-    PL_last_swash_hv   = NULL; /* reinits on demand */
-    PL_last_swash_klen = 0;
-    PL_last_swash_key[0]= '\0';
-    PL_last_swash_tmps = (U8*)NULL;
-    PL_last_swash_slen = 0;
-
     PL_srand_called    = proto_perl->Isrand_called;
     Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
 
     PL_srand_called    = proto_perl->Isrand_called;
     Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
 
@@ -15692,8 +15690,50 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_setlocale_buf = NULL;
     PL_setlocale_bufsize = 0;
 
     PL_setlocale_buf = NULL;
     PL_setlocale_bufsize = 0;
 
-    /* utf8 character class swashes */
+    /* Unicode inversion lists */
+
+    PL_AboveLatin1            = sv_dup_inc(proto_perl->IAboveLatin1, param);
+    PL_Assigned_invlist       = sv_dup_inc(proto_perl->IAssigned_invlist, param);
+    PL_GCB_invlist            = sv_dup_inc(proto_perl->IGCB_invlist, param);
+    PL_HasMultiCharFold       = sv_dup_inc(proto_perl->IHasMultiCharFold, param);
+    PL_InMultiCharFold        = sv_dup_inc(proto_perl->IInMultiCharFold, param);
+    PL_Latin1                 = sv_dup_inc(proto_perl->ILatin1, param);
+    PL_LB_invlist             = sv_dup_inc(proto_perl->ILB_invlist, param);
+    PL_SB_invlist             = sv_dup_inc(proto_perl->ISB_invlist, param);
+    PL_SCX_invlist            = sv_dup_inc(proto_perl->ISCX_invlist, param);
+    PL_UpperLatin1            = sv_dup_inc(proto_perl->IUpperLatin1, param);
+    PL_in_some_fold           = sv_dup_inc(proto_perl->Iin_some_fold, param);
+    PL_utf8_idcont            = sv_dup_inc(proto_perl->Iutf8_idcont, param);
+    PL_utf8_idstart           = sv_dup_inc(proto_perl->Iutf8_idstart, param);
+    PL_utf8_perl_idcont       = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
+    PL_utf8_perl_idstart      = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
+    PL_utf8_xidcont           = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
+    PL_utf8_xidstart          = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
+    PL_WB_invlist             = sv_dup_inc(proto_perl->IWB_invlist, param);
+    for (i = 0; i < POSIX_CC_COUNT; i++) {
+        PL_XPosix_ptrs[i]     = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+        if (i != _CC_CASED && i != _CC_VERTSPACE) {
+            PL_Posix_ptrs[i]  = sv_dup_inc(proto_perl->IPosix_ptrs[i], param);
+        }
+    }
+    PL_Posix_ptrs[_CC_CASED]  = PL_Posix_ptrs[_CC_ALPHA];
+    PL_Posix_ptrs[_CC_VERTSPACE] = NULL;
+
+    PL_utf8_toupper           = sv_dup_inc(proto_perl->Iutf8_toupper, param);
+    PL_utf8_totitle           = sv_dup_inc(proto_perl->Iutf8_totitle, param);
+    PL_utf8_tolower           = sv_dup_inc(proto_perl->Iutf8_tolower, param);
+    PL_utf8_tofold            = sv_dup_inc(proto_perl->Iutf8_tofold, param);
+    PL_utf8_tosimplefold      = sv_dup_inc(proto_perl->Iutf8_tosimplefold, param);
+    PL_utf8_charname_begin    = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
+    PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
+    PL_utf8_mark              = sv_dup_inc(proto_perl->Iutf8_mark, param);
+    PL_InBitmap               = sv_dup_inc(proto_perl->IInBitmap, param);
+    PL_CCC_non0_non230        = sv_dup_inc(proto_perl->ICCC_non0_non230, param);
+    PL_Private_Use            = sv_dup_inc(proto_perl->IPrivate_Use, param);
+
+#if 0
     PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
     PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
+#endif
 
     if (proto_perl->Ipsig_pend) {
        Newxz(PL_psig_pend, SIG_SIZE, int);
 
     if (proto_perl->Ipsig_pend) {
        Newxz(PL_psig_pend, SIG_SIZE, int);
Unnamed repository; edit this file 'description' to name the repository.