From 4ab3b2f0f166315ca3c26b4483d114a80a3763b5 Mon Sep 17 00:00:00 2001 From: Reini Urban Date: Fri, 18 Aug 2017 18:33:14 +0200 Subject: [PATCH] locale: fix partial change now always inspect the hints hash value, as the hints bit can mean plain or partial, both. This made 'use locale' slower, but freed the hints bit. --- lib/locale.pm | 5 +---- locale.c | 7 ++++++- perl.h | 46 ++++++++++++++++++++++++++++------------------ 3 files changed, 35 insertions(+), 23 deletions(-) diff --git a/lib/locale.pm b/lib/locale.pm index afe090e875a..1439ad5675d 100644 --- a/lib/locale.pm +++ b/lib/locale.pm @@ -51,7 +51,6 @@ to behave as if in the "C" locale; attempts to change the locale will fail. # argument. $locale::hint_bits = 0x4; -# $locale::partial_hint_bits = 0x10; # Unused. If pragma had an argument # The pseudo-category :characters consists of 2 real ones; but it also is # given its own number, -1, because in the complement form it also has the @@ -99,10 +98,8 @@ sub import { next; } - # $^H |= $locale::partial_hint_bits; - # This form of the pragma did override the other + $^H |= $locale::hint_bits; # Now check the $^H{locale} value. - # $^H &= ~$locale::hint_bits; $arg =~ s/^://; diff --git a/locale.c b/locale.c index 73ea700d1e9..874e589032a 100644 --- a/locale.c +++ b/locale.c @@ -4968,7 +4968,12 @@ Perl__is_in_locale_category(pTHX_ const bool compiling, const int category) /* The pseudo-category 'not_characters' is -1, so just add 1 to each to get * a valid unsigned */ assert(category >= -1); - return cBOOL(SvUV(cat_sv) & (1U << (category + 1))); + /* The 0 check is for the old HINTS_LOCALE via use locale; + The -1 check is for IN_UNI_8_BIT + */ + return cBOOL( + (category != -1 && SvUV(cat_sv) == 0) + || SvUV(cat_sv) & (1U << (category + 1)) ); } char * diff --git a/perl.h b/perl.h index 4c1ae702e5e..7e0031ef553 100644 --- a/perl.h +++ b/perl.h @@ -5372,7 +5372,8 @@ EXTCONST char *const PL_phase_names[]; # define PL_amagic_generation PL_na #endif /* !PERL_CORE */ -#define PL_hints PL_compiling.cop_hints +#define PL_hints PL_compiling.cop_hints +#define PL_hints_hash PL_compiling.cop_hints_hash END_EXTERN_C @@ -5409,7 +5410,7 @@ END_EXTERN_C #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ #define HINT_LOCALE 0x00000004 /* locale pragma */ #define HINT_BYTES 0x00000008 /* bytes pragma */ -#define HINT_LOCALE_PARTIAL 0x00000004 /* ignored. was a subset of categories */ +#define HINT_LOCALE_PARTIAL 0x00000004 /* ignored. was 0x10 categories subset */ #define HINT_EXACT_ARITH 0x00000010 /* exact_arith pragma */ #define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */ @@ -6379,19 +6380,28 @@ typedef struct am_table_short AMTS; /* Returns TRUE if the plain locale pragma without a parameter is in effect */ -# define IN_LOCALE_RUNTIME (PL_curcop \ - && CopHINTS_get(PL_curcop) & HINT_LOCALE) +# define IN_LOCALE_RUNTIME \ + (PL_curcop \ + && CopHINTS_get(PL_curcop) & HINT_LOCALE \ + && !SvIVX(cophh_fetch_pvs(PL_curcop->cop_hints_hash, "locale", 0)) \ + ) -/* Returns TRUE if either form of the locale pragma is in effect */ +/* Returns TRUE if either form of the locale pragma is in effect (unused) */ # define IN_SOME_LOCALE_FORM_RUNTIME \ - cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) + cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE) -# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE) +/* (used) */ +# define IN_LOCALE_COMPILETIME \ + cBOOL(PL_hints & HINT_LOCALE \ + && !SvIVX(cophh_fetch_pvs(PL_hints_hash, "locale", 0))) +/* (unused) */ # define IN_SOME_LOCALE_FORM_COMPILETIME \ - cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) + cBOOL(PL_hints & HINT_LOCALE) +/* Only for use locale; (used) */ # define IN_LOCALE \ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) +/* use locale ... ; (unused) */ # define IN_SOME_LOCALE_FORM \ (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \ : IN_SOME_LOCALE_FORM_RUNTIME) @@ -6399,19 +6409,19 @@ typedef struct am_table_short AMTS; # define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME # define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME +/* the next 5 are actually used */ # define IN_LC_PARTIAL_COMPILETIME \ - cBOOL(PL_hints & HINT_LOCALE_PARTIAL) + cBOOL(PL_hints & HINT_LOCALE_PARTIAL) # define IN_LC_PARTIAL_RUNTIME \ - (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL) - -# define IN_LC_COMPILETIME(category) \ - (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \ - && Perl__is_in_locale_category(aTHX_ TRUE, (category)))) -# define IN_LC_RUNTIME(category) \ - (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \ - && Perl__is_in_locale_category(aTHX_ FALSE, (category)))) + cBOOL(PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL) + +# define IN_LC_COMPILETIME(category) \ + (IN_LC_PARTIAL_COMPILETIME && Perl__is_in_locale_category(aTHX_ TRUE, (category))) +# define IN_LC_RUNTIME(category) \ + (IN_LC_PARTIAL_RUNTIME && Perl__is_in_locale_category(aTHX_ FALSE, (category))) # define IN_LC(category) \ - (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) + (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) + # if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)