In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2726666d48c2d6d699d0a840da6e9f7a2fdfde22?hp=d6609144cb1976a0816871e44add62ea336ab4de>
- Log ----------------------------------------------------------------- commit 2726666d48c2d6d699d0a840da6e9f7a2fdfde22 Author: Karl Williamson <[email protected]> Date: Mon Jan 12 22:31:07 2015 -0700 Move unlikely executed macro to function The bulk of this macro is extremely rarely executed, so it makes sense to optimize for space, as it is called from a fair number of places, and move as much as possible to a single function. For whatever it's worth, on my system with my typical compilation options, including -O0, the savings was 19640 bytes in regexec.o, 4528 in utf8.o, at a cost of 1488 in locale.o. M embed.fnc M embed.h M locale.c M perl.h M proto.h commit c0f3a893f19a236736869b0203e771705a22d986 Author: Karl Williamson <[email protected]> Date: Mon Jan 12 22:01:53 2015 -0700 locale.c: Fix memory leak. I spotted this in code review. I didn't add a test for it, because to expose the much more serious bug fixed by the previous commit, I had to temporarily change the C code to force these extremely unlikely-to-be-taken branches to execute. M locale.c commit 3945cc79918c13e0988dc96336c134bc5ce644a0 Author: Karl Williamson <[email protected]> Date: Mon Jan 12 22:06:34 2015 -0700 sv.c: Fix cloning of interp variable This should have been cloned by sv_dup_inc. I don't know why it didn't fail outside of Win32, but fail there it did, spectacularly, but only when I temporarily change some C code to force execution of the affected code, which only gets executed for problematic locales, which may very well not exist on most machines. M sv.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 1 + embed.h | 1 + locale.c | 24 ++++++++++++++++++++++++ perl.h | 15 ++++++--------- proto.h | 1 + sv.c | 8 +++++--- 6 files changed, 38 insertions(+), 12 deletions(-) diff --git a/embed.fnc b/embed.fnc index dc2ed43..bf3b35e 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1130,6 +1130,7 @@ ApOM |int |init_i18nl14n |int printwarn ApM |char* |my_strerror |const int errnum ApOM |void |new_collate |NULLOK const char* newcoll ApOM |void |new_ctype |NN const char* newctype +ApMn |void |_warn_problematic_locale ApOM |void |new_numeric |NULLOK const char* newcoll Ap |void |set_numeric_local Ap |void |set_numeric_radix diff --git a/embed.h b/embed.h index c1f98be..2342c98 100644 --- a/embed.h +++ b/embed.h @@ -45,6 +45,7 @@ #define _to_utf8_lower_flags(a,b,c,d) Perl__to_utf8_lower_flags(aTHX_ a,b,c,d) #define _to_utf8_title_flags(a,b,c,d) Perl__to_utf8_title_flags(aTHX_ a,b,c,d) #define _to_utf8_upper_flags(a,b,c,d) Perl__to_utf8_upper_flags(aTHX_ a,b,c,d) +#define _warn_problematic_locale Perl__warn_problematic_locale #define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d) #define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b) #define append_utf8_from_native_byte S_append_utf8_from_native_byte diff --git a/locale.c b/locale.c index 8fec798..e267c98 100644 --- a/locale.c +++ b/locale.c @@ -400,6 +400,7 @@ Perl_new_ctype(pTHX_ const char *newctype) /* The '0' below suppresses a bogus gcc compiler warning */ Perl_warner(aTHX_ packWARN(WARN_LOCALE), SvPVX(PL_warn_locale), 0); setlocale(LC_CTYPE, badlocale); + Safefree(badlocale); SvREFCNT_dec_NN(PL_warn_locale); PL_warn_locale = NULL; } @@ -413,6 +414,29 @@ Perl_new_ctype(pTHX_ const char *newctype) } void +Perl__warn_problematic_locale() +{ + dTHX; + + /* Outputs the message in PL_warn_locale, and then NULLS it */ + +#ifdef USE_LOCALE_CTYPE + + if (PL_warn_locale) { + /*GCC_DIAG_IGNORE(-Wformat-security); Didn't work */ + Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), + SvPVX(PL_warn_locale), + 0 /* dummy to avoid compiler warning */ ); + /* GCC_DIAG_RESTORE; */ + SvREFCNT_dec_NN(PL_warn_locale); + PL_warn_locale = NULL; + } + +#endif + +} + +void Perl_new_collate(pTHX_ const char *newcoll) { #ifdef USE_LOCALE_COLLATE diff --git a/perl.h b/perl.h index 2d3e1f7..09a1de2 100644 --- a/perl.h +++ b/perl.h @@ -5796,17 +5796,14 @@ typedef struct am_table_short AMTS; /* This internal macro should be called from places that operate under * locale rules. It there is a problem with the current locale that - * hasn't been raised yet, it will output a warning this time */ + * hasn't been raised yet, it will output a warning this time. Because + * this will so rarely be true, there is no point to optimize for + * time; instead it makes sense to minimize space used and do all the + * work in the rarely called function */ # define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \ STMT_START { \ - if (PL_warn_locale) { \ - /*GCC_DIAG_IGNORE(-Wformat-security); Didn't work */ \ - Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), \ - SvPVX(PL_warn_locale), \ - 0 /* dummy to avoid comp warning */ ); \ - /* GCC_DIAG_RESTORE; */ \ - SvREFCNT_dec_NN(PL_warn_locale); \ - PL_warn_locale = NULL; \ + if (UNLIKELY(PL_warn_locale)) { \ + _warn_problematic_locale(); \ } \ } STMT_END diff --git a/proto.h b/proto.h index f113827..0728c45 100644 --- a/proto.h +++ b/proto.h @@ -140,6 +140,7 @@ PERL_CALLCONV UV Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS \ assert(p); assert(ustrp) +PERL_CALLCONV void Perl__warn_problematic_locale(void); PERL_CALLCONV PADOFFSET Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_ALLOCMY \ diff --git a/sv.c b/sv.c index fe092c4..d86a61e 100644 --- a/sv.c +++ b/sv.c @@ -14598,9 +14598,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* Unicode features (see perlrun/-C) */ PL_unicode = proto_perl->Iunicode; - /* Should we warn if uses locale? */ - PL_warn_locale = proto_perl->Iwarn_locale; - /* Pre-5.8 signals control */ PL_signals = proto_perl->Isignals; @@ -14914,6 +14911,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_subname = sv_dup_inc(proto_perl->Isubname, param); +#ifdef USE_LOCALE_CTYPE + /* Should we warn if uses locale? */ + PL_warn_locale = sv_dup_inc(proto_perl->Iwarn_locale, param); +#endif + #ifdef USE_LOCALE_COLLATE PL_collation_name = SAVEPV(proto_perl->Icollation_name); #endif /* USE_LOCALE_COLLATE */ -- Perl5 Master Repository
