X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/20ef288c535a81f9e6186650f180b3c1dccba151..5af38e470e5404ea35b11b729d9a03653c224ccb:/sv.c diff --git a/sv.c b/sv.c index e088e5c..46d6b25 100644 --- 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). */ -#ifdef USING_MSVC6 -# pragma warning(push) -# pragma warning(disable:4756;disable:4056) -#endif 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. */ } } -#ifdef USING_MSVC6 -# pragma warning(pop) -#endif STATIC bool S_sv_2iuv_common(pTHX_ SV *const sv) @@ -5496,6 +5489,10 @@ C on C afterwards if appropriate. C and C are implemented in terms of this function. +=for apidoc Amnh||SV_CATUTF8 +=for apidoc Amnh||SV_CATBYTES +=for apidoc Amnh||SV_SMAGIC + =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: - 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 @@ -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 -class. This does not check for subtypes; use C to verify -an inheritance relationship. +class. + +This does not check for subtypes or method overloading. Use C to +verify an inheritance relationship in the same way as the C operator by +respecting any C method overloading; or C to test +directly on the actual object type. =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; - SV *sv = NULL; + SV *width_sv = NULL; 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); } - 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') { @@ -12253,17 +12251,17 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p { 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++; - sv = (ix < sv_count) ? svargs[ix] + width_sv = (ix < sv_count) ? svargs[ix] : (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) @@ -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 { - 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, - qfmt, nv); + ptr, nv); ); 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, @@ -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()"); - 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; } @@ -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()"); } + 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); } @@ -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_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; @@ -15322,6 +15325,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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; @@ -15384,13 +15389,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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); @@ -15692,8 +15690,50 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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); +#endif if (proto_perl->Ipsig_pend) { Newxz(PL_psig_pend, SIG_SIZE, int);