Skip to content
This repository has been archived by the owner on Jun 1, 2023. It is now read-only.

Commit

Permalink
locale: fix partial change
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
rurban committed Jul 1, 2019
1 parent d8829b6 commit 4ab3b2f
Show file tree
Hide file tree
Showing 3 changed files with 35 additions and 23 deletions.
5 changes: 1 addition & 4 deletions lib/locale.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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/^://;

Expand Down
7 changes: 6 additions & 1 deletion locale.c
Original file line number Diff line number Diff line change
Expand Up @@ -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 *
Expand Down
46 changes: 28 additions & 18 deletions perl.h
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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 */
Expand Down Expand Up @@ -6379,39 +6380,48 @@ 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)

# 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)

Expand Down

0 comments on commit 4ab3b2f

Please sign in to comment.