#endif
+#ifndef PERL_IN_XSUB_RE
+
+static const UV UpperLatin1_invlist[] = {
+ 3, /* Number of elements */
+ 148565664, /* Version and data structure type */
+ 1, /* 0 if the list starts at 0;
+ 1 if it starts at the element beyond 0 */
+ 0,
+ 128,
+ 256
+};
+
+#endif
+
/* ex: set ro: */
#define PL_Sock (vTHX->ISock)
#define PL_StdIO (vTHX->IStdIO)
#define PL_Sv (vTHX->ISv)
+#define PL_UpperLatin1 (vTHX->IUpperLatin1)
#define PL_XPosix_ptrs (vTHX->IXPosix_ptrs)
#define PL_Xpv (vTHX->IXpv)
#define PL_an (vTHX->Ian)
/* Unicode inversion lists */
PERLVAR(I, ASCII, SV *)
PERLVAR(I, Latin1, SV *)
+PERLVAR(I, UpperLatin1, SV *) /* Code points 128 - 255 */
PERLVAR(I, AboveLatin1, SV *)
PERLVAR(I, NonL1NonFinalFold, SV *)
PL_AboveLatin1 = _new_invlist_C_array(AboveLatin1_invlist);
PL_ASCII = _new_invlist_C_array(ASCII_invlist);
PL_Latin1 = _new_invlist_C_array(Latin1_invlist);
+ PL_UpperLatin1 = _new_invlist_C_array(UpperLatin1_invlist);
PL_L1Posix_ptrs[_CC_ALPHANUMERIC]
= _new_invlist_C_array(L1PosixAlnum_invlist);
/* Under /d, we put into a separate list the Latin1 things that
* match only when the target string is utf8 */
SV* nonascii_but_latin1_properties = NULL;
- _invlist_intersection(posixes, PL_Latin1,
+ _invlist_intersection(posixes, PL_UpperLatin1,
&nonascii_but_latin1_properties);
- _invlist_subtract(nonascii_but_latin1_properties, PL_ASCII,
- &nonascii_but_latin1_properties);
_invlist_subtract(posixes, nonascii_but_latin1_properties,
&posixes);
if (cp_list) {
return mk_invlist_from_cp_list(\@is_non_final_fold);
}
+sub UpperLatin1 {
+ my @upper_latin1;
+ for my $i (0 .. 255) { # Complicated because of EBCDIC
+ push @upper_latin1, $i if chr($i) =~ /[[:^ascii:]]/;
+ }
+ return mk_invlist_from_cp_list(\@upper_latin1);
+}
+
output_invlist("Latin1", [ 0, 256 ]);
output_invlist("AboveLatin1", [ 256 ]);
XPosixXDigit
&NonL1_Perl_Non_Final_Folds
&_Perl_Multi_Char_Folds
+ &UpperLatin1
)
) {
/* Unicode inversion lists */
PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
+ PL_UpperLatin1 = sv_dup_inc(proto_perl->IUpperLatin1, param);
PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);