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

Commit a04965a

Browse files
rurbanrurban
committed
locale: rearrange HINTS_LOCALE as suggested
We need one more hints bit, take it from HINT_LOCALE_PARTIAL. IN_LC_RUNTIME(category) and IN_LC_COMPILETIME(category) need to look into the hints hash{locale} which they do anyway. Also take away the shaped_array feature bit. It is always turned on in cperl.
1 parent 071f7ab commit a04965a

File tree

12 files changed

+117
-140
lines changed

12 files changed

+117
-140
lines changed

‎feature.h‎

Lines changed: 9 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@
1717
#define FEATURE_BUNDLE_511 2
1818
#define FEATURE_BUNDLE_515 3
1919
#define FEATURE_BUNDLE_523 4
20-
#define FEATURE_BUNDLE_527 5
2120
#define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
2221

2322
#define CURRENT_HINTS \
@@ -46,38 +45,37 @@
4645
#define FEATURE_SAY_IS_ENABLED \
4746
( \
4847
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
49-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
48+
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_523) \
5049
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
5150
FEATURE_IS_ENABLED("say")) \
5251
)
5352

5453
#define FEATURE_STATE_IS_ENABLED \
5554
( \
5655
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
57-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
56+
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_523) \
5857
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
5958
FEATURE_IS_ENABLED("state")) \
6059
)
6160

6261
#define FEATURE_SWITCH_IS_ENABLED \
6362
( \
6463
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
65-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
64+
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_523) \
6665
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
6766
FEATURE_IS_ENABLED("switch")) \
6867
)
6968

7069
#define FEATURE_BITWISE_IS_ENABLED \
7170
( \
72-
CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_527 \
73-
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
74-
FEATURE_IS_ENABLED("bitwise")) \
71+
CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
72+
FEATURE_IS_ENABLED("bitwise") \
7573
)
7674

7775
#define FEATURE_EVALBYTES_IS_ENABLED \
7876
( \
7977
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_515 && \
80-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
78+
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_523) \
8179
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
8280
FEATURE_IS_ENABLED("evalbytes")) \
8381
)
@@ -108,16 +106,15 @@
108106

109107
#define FEATURE_POSTDEREF_QQ_IS_ENABLED \
110108
( \
111-
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_523 && \
112-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
109+
CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_523 \
113110
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
114111
FEATURE_IS_ENABLED("postderef_qq")) \
115112
)
116113

117114
#define FEATURE_UNIEVAL_IS_ENABLED \
118115
( \
119116
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_515 && \
120-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
117+
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_523) \
121118
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
122119
FEATURE_IS_ENABLED("unieval")) \
123120
)
@@ -141,7 +138,7 @@
141138
#define FEATURE_UNICODE_IS_ENABLED \
142139
( \
143140
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_511 && \
144-
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \
141+
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_523) \
145142
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
146143
FEATURE_IS_ENABLED("unicode")) \
147144
)
@@ -156,9 +153,6 @@ S_enable_feature_bundle(pTHX_ SV *ver)
156153
SV *comp_ver = sv_newmortal();
157154
PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
158155
| (
159-
(sv_setnv(comp_ver, 5.027),
160-
vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
161-
? FEATURE_BUNDLE_527 :
162156
(sv_setnv(comp_ver, 5.023),
163157
vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
164158
? FEATURE_BUNDLE_523 :

‎lib/feature.pm‎

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,6 @@ our %feature_bundle = (
2929
"5.11" => [qw(say state switch unicode_strings)],
3030
"5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
3131
"5.23" => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
32-
"5.27" => [qw(bitwise evalbytes postderef_qq say state switch unicode_eval unicode_strings)],
3332
"all" => [qw(bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say shaped_arrays signatures state switch unicode_eval unicode_strings)],
3433
"default" => [qw()],
3534
);
@@ -47,21 +46,23 @@ $feature_bundle{"5.22"} = $feature_bundle{"5.15"};
4746
$feature_bundle{"5.24"} = $feature_bundle{"5.23"};
4847
$feature_bundle{"5.25"} = $feature_bundle{"5.23"};
4948
$feature_bundle{"5.26"} = $feature_bundle{"5.23"};
50-
$feature_bundle{"5.28"} = $feature_bundle{"5.27"};
51-
$feature_bundle{"5.29"} = $feature_bundle{"5.27"};
52-
$feature_bundle{"5.30"} = $feature_bundle{"5.27"};
49+
$feature_bundle{"5.27"} = $feature_bundle{"5.23"};
50+
$feature_bundle{"5.28"} = $feature_bundle{"5.23"};
51+
$feature_bundle{"5.29"} = $feature_bundle{"5.23"};
52+
$feature_bundle{"5.30"} = $feature_bundle{"5.23"};
5353
$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
5454
my %noops = (
5555
postderef => 1,
5656
lexical_subs => 1,
57+
shaped_arrays => 1,
5758
);
5859
my %removed = (
5960
array_base => 1,
6061
);
6162

6263
our $hint_shift = 26;
6364
our $hint_mask = 0x1c000000;
64-
our @hint_bundles = qw( default 5.10 5.11 5.15 5.23 5.27 );
65+
our @hint_bundles = qw( default 5.10 5.11 5.15 5.23 );
6566

6667
# This gets set (for now) in $^H as well as in %^H,
6768
# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
@@ -358,8 +359,9 @@ The declared size is always equal to the actual size, the array is
358359
pre-filled with undef. Thus shaped arrays are faster to access at run-time
359360
than aelemfast (constant indices).
360361
361-
If declared with a L<perltypes/"coretypes">, the elements are preinitialized with the
362-
corresponding C<0> values. You can also use native types.
362+
If declared with a L<perltypes/"coretypes">, the elements are
363+
preinitialized with the corresponding C<0> values. You can also use
364+
native types.
363365
364366
my Int @a[10]; # pre-declares 10 elements with IV's of value 0
365367
my UInt @a[10];# with UV's of value 0
@@ -432,10 +434,12 @@ The following feature bundles are available:
432434
postderef_qq
433435
434436
:5.28 say state switch unicode_strings
435-
unicode_eval evalbytes postderef_qq bitwise
437+
unicode_eval evalbytes current_sub fc
438+
postderef_qq
436439
437440
:5.30 say state switch unicode_strings
438-
unicode_eval evalbytes postderef_qq bitwise
441+
unicode_eval evalbytes current_sub fc
442+
postderef_qq
439443
440444
The C<:default> bundle represents the feature set that is enabled before
441445
any C<use feature> or C<no feature> declaration.

‎lib/locale.pm‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
package locale;
22

3-
our $VERSION = '1.09';
3+
our $VERSION = '1.10';
44
use Config;
55

66
$Carp::Internal{ (__PACKAGE__) } = 1;
@@ -51,7 +51,7 @@ to behave as if in the "C" locale; attempts to change the locale will fail.
5151
# argument.
5252

5353
$locale::hint_bits = 0x4;
54-
$locale::partial_hint_bits = 0x10; # If pragma has an argument
54+
# $locale::partial_hint_bits = 0x10; # Unused. If pragma had an argument
5555

5656
# The pseudo-category :characters consists of 2 real ones; but it also is
5757
# given its own number, -1, because in the complement form it also has the
@@ -63,7 +63,6 @@ sub import {
6363
$^H{locale} = 0 unless defined $^H{locale};
6464
if (! @_) { # If no parameter, use the plain form that changes all categories
6565
$^H |= $locale::hint_bits;
66-
6766
}
6867
else {
6968
my @categories = ( qw(:ctype :collate :messages
@@ -100,10 +99,10 @@ sub import {
10099
next;
101100
}
102101

103-
$^H |= $locale::partial_hint_bits;
104-
105-
# This form of the pragma overrides the other
106-
$^H &= ~$locale::hint_bits;
102+
# $^H |= $locale::partial_hint_bits;
103+
# This form of the pragma did override the other
104+
# Now check the $^H{locale} value.
105+
# $^H &= ~$locale::hint_bits;
107106

108107
$arg =~ s/^://;
109108

@@ -136,7 +135,7 @@ sub import {
136135
}
137136

138137
sub unimport {
139-
$^H &= ~($locale::hint_bits|$locale::partial_hint_bits);
138+
$^H &= ~($locale::hint_bits);
140139
$^H{locale} = 0;
141140
}
142141

‎perl.h‎

Lines changed: 40 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -5397,11 +5397,11 @@ END_EXTERN_C
53975397
#define LEX_NOTPARSING 11 /* borrowed from toke.c */
53985398

53995399
/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
5400-
special and there is no need for HINT_PRIVATE_MASK for COPs
5400+
special and there is no need for HINT_PRIVATE_MASK for COPs.
54015401
However, bitops store HINT_INTEGER in their op_private.
54025402
5403-
NOTE: The typical module using these has the bit value hard-coded, so don't
5404-
blindly change the values of these.
5403+
NOTE: The typical module using these has the bit value hard-coded, so don't
5404+
blindly change the values of these.
54055405
54065406
If we run out of bits, the 2 locale ones could be combined. The PARTIAL one
54075407
is for "use locale 'FOO'" which excludes some categories. It requires going
@@ -5412,7 +5412,8 @@ END_EXTERN_C
54125412
#define HINT_STRICT_REFS 0x00000002 /* strict pragma */
54135413
#define HINT_LOCALE 0x00000004 /* locale pragma */
54145414
#define HINT_BYTES 0x00000008 /* bytes pragma */
5415-
#define HINT_LOCALE_PARTIAL 0x00000010 /* locale, but a subset of categories */
5415+
#define HINT_LOCALE_PARTIAL 0x00000004 /* ignored. was a subset of categories */
5416+
#define HINT_EXACT_ARITH 0x00000010 /* exact_arith pragma */
54165417

54175418
#define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */
54185419
#define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */
@@ -5443,7 +5444,7 @@ END_EXTERN_C
54435444

54445445
#define HINT_RE_FLAGS 0x02000000 /* re '/xism' pragma */
54455446

5446-
#define HINT_FEATURE_MASK 0x1c000000 /* 3 bits for feature bundles */
5447+
#define HINT_FEATURE_MASK 0x1c000000 /* 3 bits (4,8,10) for feature bundles */
54475448

54485449
#define HINT_STRICT_HASHPAIRS 0x20000000 /* strict pragma */
54495450

@@ -6379,40 +6380,40 @@ typedef struct am_table_short AMTS;
63796380

63806381
#ifdef USE_LOCALE /* These locale things are all subject to change */
63816382

6382-
/* Returns TRUE if the plain locale pragma without a parameter is in effect.
6383-
* */
6384-
# define IN_LOCALE_RUNTIME (PL_curcop \
6385-
&& CopHINTS_get(PL_curcop) & HINT_LOCALE)
6386-
6387-
/* Returns TRUE if either form of the locale pragma is in effect */
6388-
# define IN_SOME_LOCALE_FORM_RUNTIME \
6389-
cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
6390-
6391-
# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
6392-
# define IN_SOME_LOCALE_FORM_COMPILETIME \
6393-
cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
6394-
6395-
# define IN_LOCALE \
6396-
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6397-
# define IN_SOME_LOCALE_FORM \
6398-
(IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
6399-
: IN_SOME_LOCALE_FORM_RUNTIME)
6400-
6401-
# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME
6402-
# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME
6403-
6404-
# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
6405-
# define IN_LC_PARTIAL_RUNTIME \
6406-
(PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
6407-
6408-
# define IN_LC_COMPILETIME(category) \
6409-
( IN_LC_ALL_COMPILETIME \
6410-
|| ( IN_LC_PARTIAL_COMPILETIME \
6411-
&& Perl__is_in_locale_category(aTHX_ TRUE, (category))))
6412-
# define IN_LC_RUNTIME(category) \
6413-
(IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
6414-
&& Perl__is_in_locale_category(aTHX_ FALSE, (category))))
6415-
# define IN_LC(category) \
6383+
/* Returns TRUE if the plain locale pragma without a parameter is in effect
6384+
*/
6385+
# define IN_LOCALE_RUNTIME (PL_curcop \
6386+
&& CopHINTS_get(PL_curcop) & HINT_LOCALE)
6387+
6388+
/* Returns TRUE if either form of the locale pragma is in effect */
6389+
# define IN_SOME_LOCALE_FORM_RUNTIME \
6390+
cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
6391+
6392+
# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
6393+
# define IN_SOME_LOCALE_FORM_COMPILETIME \
6394+
cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
6395+
6396+
# define IN_LOCALE \
6397+
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6398+
# define IN_SOME_LOCALE_FORM \
6399+
(IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
6400+
: IN_SOME_LOCALE_FORM_RUNTIME)
6401+
6402+
# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME
6403+
# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME
6404+
6405+
# define IN_LC_PARTIAL_COMPILETIME \
6406+
cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
6407+
# define IN_LC_PARTIAL_RUNTIME \
6408+
(PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
6409+
6410+
# define IN_LC_COMPILETIME(category) \
6411+
(IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \
6412+
&& Perl__is_in_locale_category(aTHX_ TRUE, (category))))
6413+
# define IN_LC_RUNTIME(category) \
6414+
(IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
6415+
&& Perl__is_in_locale_category(aTHX_ FALSE, (category))))
6416+
# define IN_LC(category) \
64166417
(IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
64176418

64186419
# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)

0 commit comments

Comments
 (0)