summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--autodoc.pl4
-rw-r--r--charclass_invlists.h2
-rw-r--r--ebcdic_tables.h6
-rw-r--r--ext/XS-APItest/t/utf8.t86
-rw-r--r--pod/perldelta.pod16
-rw-r--r--pod/perldiag.pod42
-rw-r--r--pod/perlebcdic.pod27
-rw-r--r--pod/perlport.pod3
-rw-r--r--pod/perlunicode.pod9
-rw-r--r--regcharclass.h2
-rw-r--r--regen/charset_translations.pl13
-rw-r--r--regen/ebcdic.pl6
-rw-r--r--t/lib/warnings/utf88
-rw-r--r--t/op/bop.t4
-rw-r--r--t/op/chop.t22
-rw-r--r--t/op/index.t4
-rw-r--r--t/op/ver.t4
-rw-r--r--t/re/pat_advanced.t4
-rw-r--r--toke.c5
-rw-r--r--utf8.c56
-rw-r--r--utf8.h20
-rw-r--r--utfebcdic.h44
22 files changed, 204 insertions, 183 deletions
diff --git a/autodoc.pl b/autodoc.pl
index 4a55c3cf20..865ee08114 100644
--- a/autodoc.pl
+++ b/autodoc.pl
@@ -417,8 +417,8 @@ whenever this documentation refers to C<utf8>
(and variants of that name, including in function names),
it also (essentially transparently) means C<UTF-EBCDIC>.
But the ordinals of characters differ between ASCII, EBCDIC, and
-the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
-than in UTF-8.
+the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different
+number of bytes than in UTF-8.
The listing below is alphabetical, case insensitive.
diff --git a/charclass_invlists.h b/charclass_invlists.h
index 53af07204b..1abf154122 100644
--- a/charclass_invlists.h
+++ b/charclass_invlists.h
@@ -99539,6 +99539,6 @@ static const UV XPosixXDigit_invlist[] = { /* for EBCDIC POSIX-BC */
* a18d502bad39d527ac5586d7bc93e29f565859e3bcc24ada627eff606d6f5fed lib/unicore/extracted/DNumValues.txt
* 602994a2249dfd84ae106940eb48450e3e6f1a69d489274f2618861a86f5d8e0 lib/unicore/mktables
* 462c9aaa608fb2014cd9649af1c5c009485c60b9c8b15b89401fdc10cf6161c6 lib/unicore/version
- * c6884f4d629f04d1316f3476cb1050b6a1b98ca30c903262955d4eae337c6b1e regen/charset_translations.pl
+ * 996abda3c0fbc2bfd575092af09e3b9b0331e624eb2e969a268457f8fd31ecbb regen/charset_translations.pl
* 8a097f8f726bb1619af2f27f149ab87e60a1602f790147e3a561358be16abd27 regen/mk_invlists.pl
* ex: set ro: */
diff --git a/ebcdic_tables.h b/ebcdic_tables.h
index 1669bbd202..5344d3921c 100644
--- a/ebcdic_tables.h
+++ b/ebcdic_tables.h
@@ -126,7 +126,7 @@ EXTCONST U8 PL_utf8skip[] = {
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 4, 4, 4, 4,
1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 4, 4, 4, 5, 5, 5,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 6, 6, 7, 7, 1
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 6, 6, 7, 14, 1
};
/* Index is EBCDIC 1047 code point; value is its lowercase equivalent */
@@ -339,7 +339,7 @@ EXTCONST U8 PL_utf8skip[] = {
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 4, 4, 4, 4,
1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 4, 4, 4, 5, 5, 5,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 6, 6, 7, 7, 1
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 6, 6, 7, 14, 1
};
/* Index is EBCDIC 037 code point; value is its lowercase equivalent */
@@ -552,7 +552,7 @@ EXTCONST U8 PL_utf8skip[] = {
3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3,
3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 4, 4, 4, 4, 4,
4, 4, 1, 1, 1, 1, 1, 1, 1, 1, 4, 5, 5, 5, 5, 6,
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 6, 1, 7, 1, 7, 1
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 6, 1, 7, 1, 14, 1
};
/* Index is EBCDIC POSIX-BC code point; value is its lowercase equivalent */
diff --git a/ext/XS-APItest/t/utf8.t b/ext/XS-APItest/t/utf8.t
index 4cafe2f3f6..61a3ff8de4 100644
--- a/ext/XS-APItest/t/utf8.t
+++ b/ext/XS-APItest/t/utf8.t
@@ -206,13 +206,10 @@ my %code_points = (
0x40000000 - 1 => (isASCII) ? "\xfc\xbf\xbf\xbf\xbf\xbf" : I8_to_native("\xfe\xbf\xbf\xbf\xbf\xbf\xbf"),
0x40000000 => (isASCII) ? "\xfd\x80\x80\x80\x80\x80" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa1\xa0\xa0\xa0\xa0\xa0\xa0"),
0x80000000 - 1 => (isASCII) ? "\xfd\xbf\xbf\xbf\xbf\xbf" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa1\xbf\xbf\xbf\xbf\xbf\xbf"),
+ 0x80000000 => (isASCII) ? "\xfe\x82\x80\x80\x80\x80\x80" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0"),
+ 0xFFFFFFFF => (isASCII) ? "\xfe\x83\xbf\xbf\xbf\xbf\xbf" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa3\xbf\xbf\xbf\xbf\xbf\xbf"),
);
-if (isASCII) {
- $code_points{0x80000000} = "\xfe\x82\x80\x80\x80\x80\x80";
- $code_points{0xFFFFFFFF} = "\xfe\x83\xbf\xbf\xbf\xbf\xbf";
-}
-
if ($is64bit) {
no warnings qw(overflow portable);
$code_points{0x100000000} = (isASCII) ? "\xfe\x84\x80\x80\x80\x80\x80" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa4\xa0\xa0\xa0\xa0\xa0\xa0");
@@ -292,8 +289,8 @@ for my $u (sort { utf8::unicode_to_native($a) <=> utf8::unicode_to_native($b) }
$u < 0x4000 ? 3 :
$u < 0x40000 ? 4 :
$u < 0x400000 ? 5 :
- $u < 0x4000000 ? 6 : 7
- );
+ $u < 0x4000000 ? 6 :
+ $u < 0x40000000 ? 7 : 14 );
}
# If this test fails, subsequent ones are meaningless.
@@ -466,22 +463,19 @@ my @malformations = (
0, # NUL
2,
qr/2 bytes, need 1/
- ]
-);
-
-if (isASCII) {
- push @malformations,
+ ],
[ "overflow malformation",
# These are the smallest overflowing on 64 byte machines:
# 2**64
- "\xff\x80\x90\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0",
- 13,
+ (isASCII) ? "\xff\x80\x90\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"
+ : I8_to_native("\xff\xB0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
+ (isASCII) ? 13 : 14,
0, # There is no way to allow this malformation
$REPLACEMENT,
- 13,
+ (isASCII) ? 13 : 14,
qr/overflow/
- ];
-}
+ ],
+);
foreach my $test (@malformations) {
my ($testname, $bytes, $length, $allow_flags, $allowed_uv, $expected_len, $message ) = @$test;
@@ -535,16 +529,6 @@ foreach my $test (@malformations) {
}
}
-my $FF_ret;
-
-if ($is64bit) {
- no warnings qw{portable overflow};
- $FF_ret = 0x1000000000;
-}
-else { # The above overflows unless a quad platform
- $FF_ret = 0;
-}
-
# Now test the cases where a legal code point is generated, but may or may not
# be allowed/warned on.
my @tests = (
@@ -829,54 +813,60 @@ my @tests = (
(isASCII) ? 4 : 5,
qr/Unicode non-character.*is not recommended for open interchange/
],
-);
-
-
-if (isASCII) {
- push @tests,
[ "requires at least 32 bits",
- "\xfe\x82\x80\x80\x80\x80\x80",
-
+ (isASCII)
+ ? "\xfe\x82\x80\x80\x80\x80\x80"
+ : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0"),
# This code point is chosen so that it is representable in a UV on
# 32-bit machines
$UTF8_WARN_ABOVE_31_BIT, $UTF8_DISALLOW_ABOVE_31_BIT,
- 'utf8', 0x80000000, 7,
+ 'utf8', 0x80000000, (isASCII) ? 7 :14,
qr/Code point 0x80000000 is not Unicode, and not portable/
],
[ "requires at least 32 bits, and use SUPER-type flags, instead of ABOVE_31_BIT",
- "\xfe\x82\x80\x80\x80\x80\x80",
+ (isASCII)
+ ? "\xfe\x82\x80\x80\x80\x80\x80"
+ : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0"),
$UTF8_WARN_SUPER, $UTF8_DISALLOW_SUPER,
- 'utf8', 0x80000000, 7,
+ 'utf8', 0x80000000, (isASCII) ? 7 :14,
qr/Code point 0x80000000 is not Unicode, and not portable/
],
[ "overflow with warnings/disallow for more than 31 bits",
# This tests the interaction of WARN_ABOVE_31_BIT/DISALLOW_ABOVE_31_BIT
# with overflow. The overflow malformation is never allowed, so
# preventing it takes precedence if the ABOVE_31_BIT options would
- # otherwise allow in an overflowing value. These two code points (1
+ # otherwise allow in an overflowing value. The ASCII code points (1
# for 32-bits; 1 for 64) were chosen because the old overflow
# detection algorithm did not catch them; this means this test also
- # checks for that fix.
- ($is64bit)
- ? "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"
- : "\xfe\x86\x80\x80\x80\x80\x80",
+ # checks for that fix. The EBCDIC are arbitrary overflowing ones
+ # since we have no reports of failures with it.
+ (($is64bit)
+ ? ((isASCII)
+ ? "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"
+ : I8_to_native("\xff\xB0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"))
+ : ((isASCII)
+ ? "\xfe\x86\x80\x80\x80\x80\x80"
+ : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa4\xa0\xa0\xa0\xa0\xa0\xa0"))),
# We include both warning categories to make sure the ABOVE_31_BIT one
# has precedence
"$UTF8_WARN_ABOVE_31_BIT|$UTF8_WARN_SUPER",
"$UTF8_DISALLOW_ABOVE_31_BIT",
'utf8', 0,
- ($is64bit) ? 13 : 7,
+ (! isASCII) ? 14 : ($is64bit) ? 13 : 7,
qr/overflow at byte .*, after start byte 0xf/
],
- ;
-}
+);
-if ($is64bit) { # All FF's will overflow on 32 bit
+if ($is64bit) {
+ no warnings qw{portable overflow};
push @tests,
- [ "More than 32 bits", "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ [ "More than 32 bits",
+ (isASCII)
+ ? "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80"
+ : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
$UTF8_WARN_ABOVE_31_BIT, $UTF8_DISALLOW_ABOVE_31_BIT,
- 'utf8', $FF_ret, 13,
+ 'utf8', 0x1000000000, (isASCII) ? 13 : 14,
qr/Code point 0x.* is not Unicode, and not portable/
];
}
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index c856a43792..7bfa959e9f 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -305,9 +305,19 @@ L</Modules and Pragmata> section.
=over 4
-=item XXX-some-platform
-
-XXX
+=item EBCDIC platforms, such as z/OS
+
+UTF-EBCDIC is like UTF-8, but for EBCDIC platforms. It now has been
+extended so that it can represent code points up to 2 ** 64 - 1 on
+platforms with 64-bit words. This brings it into parity with UTF-8.
+This enhancement requires an incompatible change to the representation
+of code points in the range 2 ** 30 to 2 ** 31 -1 (the latter was the
+previous maximum representable code point). This means that a file that
+contains one of these code points, written out with previous versions of
+perl cannot be read in, without conversion, by a perl containing this
+change. We do not believe any such files are in existence, but if you
+do have one, submit a ticket at L<mailto:perlbug@perl.org>, and we will
+write a conversion script for you.
=back
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 511141013c..38f135068b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1623,17 +1623,41 @@ This subroutine cannot be called.
(F) You had a (sub-)template that ends with a '/'. There must be
another template code following the slash. See L<perlfunc/pack>.
+=item Code point 0x%X is not Unicode, and not portable
+
+(S non_unicode) You had a code point that has never been in any
+standard, so it is likely that languages other than Perl will NOT
+understand it. At one time, it was legal in some standards to have code
+points up to 0x7FFF_FFFF, but not higher, and this code point is higher.
+
+Acceptance of these code points is a Perl extension, and you should
+expect that nothing other than Perl can handle them; Perl itself on
+EBCDIC platforms before v5.24 does not handle them.
+
+Code points above 0xFFFF_FFFF require larger than a 32 bit word.
+
+Perl also makes no guarantees that the representation of these code
+points won't change at some point in the future, say when machines
+become available that have larger than a 64-bit word. At that time,
+files written by an older Perl would require conversion before being
+readable by a newer Perl.
+
=item Code point 0x%X is not Unicode, may not be portable
(S non_unicode) You had a code point above the Unicode maximum
of U+10FFFF.
-Perl allows strings to contain a superset of Unicode code points, up
-to the limit of what is storable in an unsigned integer on your system,
-but these may not be accepted by other languages/systems. At one time,
-it was legal in some standards to have code points up to 0x7FFF_FFFF,
-but not higher. Code points above 0xFFFF_FFFF require larger than a
-32 bit word.
+Perl allows strings to contain a superset of Unicode code points, but
+these may not be accepted by other languages/systems. Further, even if
+these languages/systems accept these large code points, they may have
+chosen a different representation for them than the UTF-8-like one that
+Perl has, which would mean files are not exchangeable between them and
+Perl.
+
+On EBCDIC platforms, code points above 0x3FFF_FFFF have a different
+representation in Perl v5.24 than before, so any file containing these
+that was written before that version will require conversion before
+being readable by a later Perl.
=item %s: Command not found
@@ -2597,12 +2621,6 @@ parent '%s'
C3-consistent, and you have enabled the C3 MRO for this class. See the C3
documentation in L<mro> for more information.
-=item In EBCDIC the v-string components cannot exceed 2147483647
-
-(F) An error peculiar to EBCDIC. Internally, v-strings are stored as
-Unicode code points, and encoded in EBCDIC as UTF-EBCDIC. The UTF-EBCDIC
-encoding is limited to code points no larger than 2147483647 (0x7FFFFFFF).
-
=item Infinite recursion in regex
(F) You used a pattern that references itself without consuming any input
diff --git a/pod/perlebcdic.pod b/pod/perlebcdic.pod
index e54084aafc..552a8a3a37 100644
--- a/pod/perlebcdic.pod
+++ b/pod/perlebcdic.pod
@@ -243,15 +243,15 @@ In UTF-EBCDIC, there are 160 invariant characters.
which have ASCII equivalents, plus those that correspond to
the C1 controls (128 - 159 on ASCII platforms).)
-A string encoded in UTF-EBCDIC may be longer (but never shorter) than
-one encoded in UTF-8. Perl extends UTF-8 so that it can encode code
-points above the Unicode maximum of U+10FFFF. It extends UTF-EBCDIC as
-well, but due to the inherent limitations in UTF-EBCDIC, the maximum
-code point expressible is U+7FFF_FFFF, even if the word size is more
-than 32 bits.
+A string encoded in UTF-EBCDIC may be longer (very rarely shorter) than
+one encoded in UTF-8. Perl extends both UTF-8 and UTF-EBCDIC so that
+they can encode code points above the Unicode maximum of U+10FFFF. Both
+extensions are constructed to allow encoding of any code point that fits
+in a 64-bit word.
UTF-EBCDIC is defined by
-L<Unicode Technical Report #16|http://www.unicode.org/reports/tr16>.
+L<Unicode Technical Report #16|http://www.unicode.org/reports/tr16>
+(often referred to as just TR16).
It is defined based on CCSID 1047, not allowing for the differences for
other code pages. This allows for easy interchange of text between
computers running different code pages, but makes it unusable, without
@@ -268,6 +268,11 @@ invariant. This means that text generated on a computer running one
version of Perl's UTF-EBCDIC has to be translated to be intelligible to
a computer running another.
+TR16 implies a method to extend UTF-EBCDIC to encode points up through
+S<C<2 ** 31 - 1>>. Perl uses this method for code points up through
+S<C<2 ** 30 - 1>>, but uses an incompatible method for larger ones, to
+enable it to handle much larger code points than otherwise.
+
=head2 Using Encode
Starting from Perl 5.8 you can use the standard module Encode
@@ -1226,10 +1231,6 @@ character return value on an EBCDIC platform. For example:
$CAPITAL_LETTER_A = chr(193);
-The largest code point that is representable in UTF-EBCDIC is
-U+7FFF_FFFF. If you do C<chr()> on a larger value, a runtime error
-(similar to division by 0) will happen.
-
=item C<ord()>
C<ord()> will return EBCDIC code number values on an EBCDIC platform.
@@ -1264,10 +1265,6 @@ is true on all platforms. If you want native code points for the low
will hold.
-The largest code point that is representable in UTF-EBCDIC is
-U+7FFF_FFFF. If you try to pack a larger value into a character, a
-runtime error (similar to division by 0) will happen.
-
=item C<print()>
One must be careful with scalars and strings that are passed to
diff --git a/pod/perlport.pod b/pod/perlport.pod
index 8e872e4172..031b2b10a9 100644
--- a/pod/perlport.pod
+++ b/pod/perlport.pod
@@ -242,9 +242,6 @@ C<Storable>
(included as of Perl 5.8). Keeping all data as text significantly
simplifies matters.
-The v-strings are portable only up to v2147483647 (0x7FFF_FFFF), that's
-how far EBCDIC, or more precisely UTF-EBCDIC will go.
-
=head2 Files and Filesystems
Most platforms these days structure files in a hierarchical fashion.
diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod
index a407faf306..aa0fdca2e4 100644
--- a/pod/perlunicode.pod
+++ b/pod/perlunicode.pod
@@ -1300,10 +1300,11 @@ This means that all the basic characters (which includes all
those that have ASCII equivalents (like C<"A">, C<"0">, C<"%">, I<etc.>)
are the same in both EBCDIC and UTF-EBCDIC.)
-UTF-EBCDIC is used on EBCDIC platforms. The largest Unicode code points
-take 5 bytes to represent (instead of 4 in UTF-8), and Perl extends it
-to a maximum of 7 bytes to encode pode points up to what can fit in a
-32-bit word (instead of 13 bytes and a 64-bit word in UTF-8).
+UTF-EBCDIC is used on EBCDIC platforms. It generally requires more
+bytes to represent a given code point than UTF-8 does; the largest
+Unicode code points take 5 bytes to represent (instead of 4 in UTF-8),
+and, extended for 64-bit words, it uses 14 bytes instead of 13 bytes in
+UTF-8.
=item *
diff --git a/regcharclass.h b/regcharclass.h
index b947bf290d..54a5011c88 100644
--- a/regcharclass.h
+++ b/regcharclass.h
@@ -2516,7 +2516,7 @@
* a18d502bad39d527ac5586d7bc93e29f565859e3bcc24ada627eff606d6f5fed lib/unicore/extracted/DNumValues.txt
* 602994a2249dfd84ae106940eb48450e3e6f1a69d489274f2618861a86f5d8e0 lib/unicore/mktables
* 462c9aaa608fb2014cd9649af1c5c009485c60b9c8b15b89401fdc10cf6161c6 lib/unicore/version
- * c6884f4d629f04d1316f3476cb1050b6a1b98ca30c903262955d4eae337c6b1e regen/charset_translations.pl
+ * 996abda3c0fbc2bfd575092af09e3b9b0331e624eb2e969a268457f8fd31ecbb regen/charset_translations.pl
* d9c04ac46bdd81bb3e26519f2b8eb6242cb12337205add3f7cf092b0c58dccc4 regen/regcharclass.pl
* 393f8d882713a3ba227351ad0f00ea4839fda74fcf77dcd1cdf31519925adba5 regen/regcharclass_multi_char_folds.pl
* ex: set ro: */
diff --git a/regen/charset_translations.pl b/regen/charset_translations.pl
index 9696560e8f..b37c3cdd6a 100644
--- a/regen/charset_translations.pl
+++ b/regen/charset_translations.pl
@@ -2,6 +2,10 @@
use strict;
use warnings;
+# WARNING: This must be kept in sync with the UTF8_MAXBYTES value in
+# utfebcdic.h
+$CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES = 14;
+
# Utilities for various character set issues. Currently handles ASCII and
# EBCDIC only. It is trivial to add support for new EBCDIC code pages (unless
# they have identical variant character signatures as existing ones, and there
@@ -234,12 +238,13 @@ sub get_I8_2_utf($) {
sub _UTF_START_MASK($) {
# Internal
my $len = shift;
- return ((($len) >= 6) ? 0x01 : (0x1F >> (($len)-2)));
+ return (($len >= 7) ? 0x00 : (0x1F >> ($len - 2)));
}
sub _UTF_START_MARK($) {
# Internal
- return (0xFF & (0xFE << (7-(shift))));
+ my $len = shift;
+ return (($len > 7) ? 0xFF : (0xFF & (0xFE << (7- $len))));
}
sub cp_2_utfbytes($$) {
@@ -269,7 +274,9 @@ sub cp_2_utfbytes($$) {
$ucp < 0x4000 ? 3 :
$ucp < 0x40000 ? 4 :
$ucp < 0x400000 ? 5 :
- $ucp < 0x4000000 ? 6 : 7;
+ $ucp < 0x4000000 ? 6 :
+ $ucp < 0x40000000? 7 :
+ $CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES;
my @str;
for (1 .. $len - 1) {
diff --git a/regen/ebcdic.pl b/regen/ebcdic.pl
index b50d11ae97..fa8a051dfc 100644
--- a/regen/ebcdic.pl
+++ b/regen/ebcdic.pl
@@ -102,7 +102,11 @@ END
# order 1-bits (up to 7)
for my $i (0xC0 .. 255) {
my $count;
- if (($i & 0b11111110) == 0b11111110) {
+ if ($i == 0b11111111) {
+ no warnings 'once';
+ $count = $CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES;
+ }
+ elsif (($i & 0b11111110) == 0b11111110) {
$count= 7;
}
elsif (($i & 0b11111100) == 0b11111100) {
diff --git a/t/lib/warnings/utf8 b/t/lib/warnings/utf8
index 809785b4d1..df1ccd67fd 100644
--- a/t/lib/warnings/utf8
+++ b/t/lib/warnings/utf8
@@ -88,18 +88,12 @@ Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 2.
Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 3.
Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 5.
########
-BEGIN {
- if (ord('A') == 193) {
- print "SKIPPED\n# ebcdic platforms can't handle this large a code point";
- exit 0;
- }
-}
use warnings 'utf8';
my $big_nonUnicode = uc(chr(0x8000_0000));
no warnings 'non_unicode';
my $big_nonUnicode = uc(chr(0x8000_0000));
EXPECT
-Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 8.
+Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 2.
########
use warnings 'utf8';
my $d7ff = lc pack("U", 0xD7FF);
diff --git a/t/op/bop.t b/t/op/bop.t
index 409c91b7de..a037b06f68 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -136,9 +136,7 @@ is (sprintf("%vd", v120.300 ^ v200.400), '176.188');
# UTF8 ~ behaviour
#
-SKIP: {
- skip "Complements exceed maximum representable on EBCDIC ", 5 if $::IS_EBCDIC;
-
+{
my @not36;
for (0x100...0xFFF) {
diff --git a/t/op/chop.t b/t/op/chop.t
index bdeaf0d2d6..a1126dc064 100644
--- a/t/op/chop.t
+++ b/t/op/chop.t
@@ -7,7 +7,6 @@ BEGIN {
}
my $tests_count = 148;
-$tests_count -= 2 if $::IS_EBCDIC;
plan tests => $tests_count;
$_ = 'abc';
@@ -249,31 +248,24 @@ foreach my $start (@chars) {
ok(1, "extend sp in pp_chomp");
}
-SKIP: {
+{
# [perl #73246] chop doesn't support utf8
# the problem was UTF8_IS_START() didn't handle perl's extended UTF8
- skip("Not representable in EBCDIC", 2) if $::IS_EBCDIC;
- # We use hex constants instead of literal chars to avoid compilation
- # errors in EBCDIC.
- my $first_char = 0x80000001;
- my $second_char = 0x80000000;
- my $utf = chr($first_char) . chr($second_char);
+ my $utf = "\x{80000001}\x{80000000}";
my $result = chop($utf);
- is($utf, chr $first_char, "chopping high 'unicode'- remnant");
- is($result, chr $second_char, "chopping high 'unicode' - result");
+ is($utf, "\x{80000001}", "chopping high 'unicode'- remnant");
+ is($result, "\x{80000000}", "chopping high 'unicode' - result");
SKIP: {
no warnings 'overflow'; # avoid compile-time warnings below on 32-bit architectures
use Config;
$Config{ivsize} >= 8
or skip("this build can't handle very large characters", 2);
- my $first_char = 0xffffffffffffffff;
- my $second_char = 0xfffffffffffffffe;
- my $utf = chr($first_char) . chr($second_char);
+ my $utf = "\x{ffffffffffffffff}\x{fffffffffffffffe}";
my $result = chop $utf;
- is($utf, chr $first_char, "chop even higher 'unicode' - remnant");
- is($result, chr $second_char, "chop even higher 'unicode' - result");
+ is($utf, "\x{ffffffffffffffff}", "chop even higher 'unicode' - remnant");
+ is($result, "\x{fffffffffffffffe}", "chop even higher 'unicode' - result");
}
}
diff --git a/t/op/index.t b/t/op/index.t
index 243cc1bff6..8d21de76a1 100644
--- a/t/op/index.t
+++ b/t/op/index.t
@@ -129,9 +129,7 @@ is(rindex($a, "foo", ), 0);
is (rindex($text, $search_octets), -1);
}
-SKIP: {
- skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if $::IS_EBCDIC;
-
+{
my $a = eval q{"\x{80000000}"};
my $s = $a.'defxyz';
is(index($s, 'def'), 1, "0x80000000 is a single character");
diff --git a/t/op/ver.t b/t/op/ver.t
index 144a3525ce..cbbebba658 100644
--- a/t/op/ver.t
+++ b/t/op/ver.t
@@ -223,9 +223,7 @@ $v = $revision + $version/1000 + $subversion/1000000;
ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
-SKIP: {
- skip("In EBCDIC the v-string components cannot exceed 2147483647", 6)
- if $::IS_EBCDIC;
+{
# [ID 20010902.001] check if v-strings handle full UV range or not
if ( $Config{'uvsize'} >= 4 ) {
diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index df8090c4f0..86277539da 100644
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -2372,15 +2372,13 @@ EOF
sub Is_32_Bit_Super { return "110000\tFFFFFFFF\n" }
sub Is_Portable_Super { return '!utf8::Any' } # Matches beyond 32 bits
- SKIP:
{ # Assertion was failing on on 64-bit platforms; just didn't work on 32.
- skip("EBCDIC only goes to 31 bits", 4) if $::IS_EBCDIC;
no warnings qw(non_unicode portable);
use Config;
# We use 'ok' instead of 'like' because the warnings are lexically
# scoped, and want to turn them off, so have to do the match in this
- # scope. (EBCDIC platforms can't handle above 2**32 - 1
+ # scope.
if ($Config{uvsize} < 8) {
ok(chr(0xFFFF_FFFE) =~ /\p{Is_32_Bit_Super}/,
"chr(0xFFFF_FFFE) can match a Unicode property");
diff --git a/toke.c b/toke.c
index f7d4e53490..b9fe9aea5a 100644
--- a/toke.c
+++ b/toke.c
@@ -11393,10 +11393,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
"Integer overflow in decimal number");
}
}
-#ifdef EBCDIC
- if (rev > 0x7FFFFFFF)
- Perl_croak(aTHX_ "In EBCDIC the v-string components cannot exceed 2147483647");
-#endif
+
/* Append native character for the rev point */
tmpend = uvchr_to_utf8(tmpbuf, rev);
sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
diff --git a/utf8.c b/utf8.c
index 6382cf0256..52b6b986cd 100644
--- a/utf8.c
+++ b/utf8.c
@@ -109,11 +109,6 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
return d;
}
-#ifdef EBCDIC
- /* Not representable in UTF-EBCDIC */
- flags |= UNICODE_DISALLOW_FE_FF;
-#endif
-
/* The first problematic code point is the first surrogate */
if ( flags /* It's common to turn off all these */
&& uv >= UNICODE_SURROGATE_FIRST)
@@ -142,10 +137,6 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
if (flags & UNICODE_DISALLOW_SUPER
|| (UNICODE_IS_FE_FF(uv) && (flags & UNICODE_DISALLOW_FE_FF)))
{
-#ifdef EBCDIC
- Perl_die(aTHX_ "Can't represent character for Ox%"UVXf" on this platform", uv);
- NOT_REACHED; /* NOTREACHED */
-#endif
return NULL;
}
}
@@ -591,7 +582,6 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
for (s = s0 + 1; s < send; s++) {
if (LIKELY(UTF8_IS_CONTINUATION(*s))) {
-#ifndef EBCDIC /* Can't overflow in EBCDIC */
if (uv & UTF_ACCUMULATION_OVERFLOW_MASK) {
/* The original implementors viewed this malformation as more
@@ -603,7 +593,6 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
overflowed = TRUE;
overflow_byte = *s; /* Save for warning message's use */
}
-#endif
uv = UTF8_ACCUMULATE(uv, *s);
}
else {
@@ -670,12 +659,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
}
}
-#ifndef EBCDIC /* EBCDIC can't overflow */
if (UNLIKELY(overflowed)) {
sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (overflow at byte 0x%02x, after start byte 0x%02x)", malformed_text, overflow_byte, *s0));
goto malformed;
}
-#endif
if (do_overlong_test
&& expectlen > (STRLEN) OFFUNISKIP(uv)
@@ -720,14 +707,39 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
uv));
pack_warn = packWARN(WARN_NON_UNICODE);
}
-#ifndef EBCDIC /* Can never have the equivalent of FE nor FF on EBCDIC, since
- not representable in UTF-EBCDIC */
-
- /* The first byte being 0xFE or 0xFF is a subset of the SUPER code
- * points. We test for these after the regular SUPER ones, and
- * before possibly bailing out, so that the more dire warning
- * overrides the regular one, if applicable */
- if ((*s0 & 0xFE) == 0xFE /* matches both FE, FF */
+
+ /* The maximum code point ever specified by a standard was
+ * 2**31 - 1. Anything larger than that is a Perl extension that
+ * very well may not be understood by other applications (including
+ * earlier perl versions on EBCDIC platforms). On ASCII platforms,
+ * these code points are indicated by the first UTF-8 byte being
+ * 0xFE or 0xFF, hence names like 'UTF8_WARN_FE_FF'. These names
+ * are ASCII-centric, because the criteria is different On EBCDIC
+ * platforms. We test for these after the regular SUPER ones, and
+ * before possibly bailing out, so that the slightly more dire
+ * warning will override the regular one. */
+ if (
+#ifndef EBCDIC
+ (*s0 & 0xFE) == 0xFE /* matches both FE, FF */
+#else
+ /* The I8 for 2**31 (U+80000000) is
+ * \xFF\xA0\xA0\xA0\xA0\xA0\xA0\xA2\xA0\xA0\xA0\xA0\xA0\xA0
+ * and it turns out that on all EBCDIC pages recognized that
+ * the UTF-EBCDIC for that code point is
+ * \xFE\x41\x41\x41\x41\x41\x41\x43\x41\x41\x41\x41\x41\x41
+ * For the next lower code point, the 1047 UTF-EBCDIC is
+ * \xFE\x41\x41\x41\x41\x41\x41\x42\x73\x73\x73\x73\x73\x73
+ * The other code pages differ only in the bytes following
+ * \x42. Thus the following works (the minimum continuation
+ * byte is \x41). */
+ *s0 == 0xFE && send - s0 > 7 && ( s0[1] > 0x41
+ || s0[2] > 0x41
+ || s0[3] > 0x41
+ || s0[4] > 0x41
+ || s0[5] > 0x41
+ || s0[6] > 0x41
+ || s0[7] > 0x42)
+#endif
&& (flags & (UTF8_WARN_FE_FF|UTF8_WARN_SUPER|UTF8_DISALLOW_FE_FF)))
{
if ( ! (flags & UTF8_CHECK_ONLY)
@@ -743,7 +755,7 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
goto disallowed;
}
}
-#endif
+
if (flags & UTF8_DISALLOW_SUPER) {
goto disallowed;
}
diff --git a/utf8.h b/utf8.h
index 4f01277187..c3704de749 100644
--- a/utf8.h
+++ b/utf8.h
@@ -231,16 +231,6 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
* represent a code point > 255? */
#define UTF8_IS_ABOVE_LATIN1(c) ((U8)(c) >= 0xc4)
-/* This defines the 1-bits that are to be in the first byte of a multi-byte
- * UTF-8 encoded character that give the number of bytes that comprise the
- * character. 'len' is the number of bytes in the multi-byte sequence. */
-#define UTF_START_MARK(len) (((len) > 7) ? 0xFF : (0xFF & (0xFE << (7-(len)))))
-
-/* Masks out the initial one bits in a start byte, leaving the real data ones.
- * Doesn't work on an invariant byte. 'len' is the number of bytes in the
- * multi-byte sequence that comprises the character. */
-#define UTF_START_MASK(len) (((len) >= 7) ? 0x00 : (0x1F >> ((len)-2)))
-
/* This defines the bits that are to be in the continuation bytes of a multi-byte
* UTF-8 encoded character that indicate it is a continuation byte. */
#define UTF_CONTINUATION_MARK 0x80
@@ -329,6 +319,16 @@ encoded as UTF-8. C<cp> is a native (ASCII or EBCDIC) code point if less than
#define I8_TO_NATIVE(ch) I8_TO_NATIVE_UTF8(ch)
#define NATIVE8_TO_UNI(ch) NATIVE_TO_LATIN1(ch)
+/* This defines the 1-bits that are to be in the first byte of a multi-byte
+ * UTF-8 encoded character that give the number of bytes that comprise the
+ * character. 'len' is the number of bytes in the multi-byte sequence. */
+#define UTF_START_MARK(len) (((len) > 7) ? 0xFF : (0xFF & (0xFE << (7-(len)))))
+
+/* Masks out the initial one bits in a start byte, leaving the real data ones.
+ * Doesn't work on an invariant byte. 'len' is the number of bytes in the
+ * multi-byte sequence that comprises the character. */
+#define UTF_START_MASK(len) (((len) >= 7) ? 0x00 : (0x1F >> ((len)-2)))
+
/* Adds a UTF8 continuation byte 'new' of information to a running total code
* point 'old' of all the continuation bytes so far. This is designed to be
* used in a loop to convert from UTF-8 to the code point represented. Note
diff --git a/utfebcdic.h b/utfebcdic.h
index 1e4dc7c26a..bf54d4c096 100644
--- a/utfebcdic.h
+++ b/utfebcdic.h
@@ -27,10 +27,14 @@
* invariant byte starts with 0 starts with 0 or 100
* continuation byte starts with 10 starts with 101
* start byte same in both: if the code point requires N bytes,
- * then the leading N bits are 1, followed by a 0. (No
- * trailing 0 for the very largest possible allocation
- * in I8, far beyond the current Unicode standard's
- * max, as shown in the comment later in this file.)
+ * then the leading N bits are 1, followed by a 0. If
+ * all 8 bits in the first byte are 1, the code point
+ * will occupy 14 bytes (compared to 13 in Perl's
+ * extended UTF-8). This is incompatible with what
+ * tr16 implies should be the representation of code
+ * points 2**30 and above, but allows Perl to be able
+ * to represent all code points that fit in a 64-bit
+ * word in either our extended UTF-EBCDIC or UTF-8.
* 3) Use the algorithm in tr16 to convert each byte from step 2 into
* final UTF-EBCDIC. This is done by table lookup from a table
* constructed from the algorithm, reproduced in ebcdic_tables.h as
@@ -149,13 +153,17 @@ END_EXTERN_C
/* NOTE: Strictly speaking Perl's UTF-8 should not be called UTF-8 since UTF-8
* is an encoding of Unicode, and Unicode's upper limit, 0x10FFFF, can be
* expressed with 5 bytes. However, Perl thinks of UTF-8 as a way to encode
- * non-negative integers in a binary format, even those above Unicode. */
-#define UTF8_MAXBYTES 7
+ * non-negative integers in a binary format, even those above Unicode. 14 is
+ * the smallest number that covers 2**64
+ *
+ * WARNING: This number must be in sync with the value in
+ * regen/charset_translations.pl. */
+#define UTF8_MAXBYTES 14
/*
- The following table is adapted from tr16, it shows I8 encoding of Unicode code points.
+ The following table is adapted from tr16, it shows the I8 encoding of Unicode code points.
- Unicode U32 Bit pattern 1st Byte 2nd Byte 3rd Byte 4th Byte 5th Byte 6th Byte 7th byte
+ Unicode U32 Bit pattern 1st Byte 2nd Byte 3rd Byte 4th Byte 5th Byte 6th Byte 7th Byte
U+0000..U+007F 000000000xxxxxxx 0xxxxxxx
U+0080..U+009F 00000000100xxxxx 100xxxxx
U+00A0..U+03FF 000000yyyyyxxxxx 110yyyyy 101xxxxx
@@ -163,12 +171,17 @@ END_EXTERN_C
U+4000..U+3FFFF 0wwwzzzzzyyyyyxxxxx 11110www 101zzzzz 101yyyyy 101xxxxx
U+40000..U+3FFFFF 0vvwwwwwzzzzzyyyyyxxxxx 111110vv 101wwwww 101zzzzz 101yyyyy 101xxxxx
U+400000..U+3FFFFFF 0uvvvvvwwwwwzzzzzyyyyyxxxxx 1111110u 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
- U+4000000..U+7FFFFFFF 0tuuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 1111111t 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
+ U+4000000..U+3FFFFFFF 00uuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 11111110 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
- Note: The I8 transformation is valid for UCS-4 values X'0' to
- X'7FFFFFFF' (the full extent of ISO/IEC 10646 coding space).
+Beyond this, Perl uses an incompatible extension, similar to the one used in
+regular UTF-8. There are now 14 bytes. A full 32 bits of information thus looks like this:
+ 1st Byte 2nd-7th 8th Byte 9th Byte 10th B 11th B 12th B 13th B 14th B
+U+40000000..U+FFFFFFFF ttuuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 11111111 10100000 101000tt 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
- */
+For 32-bit words, the 2nd through 7th bytes effectively function as leading
+zeros. Above 32 bits, these fill up, with each byte yielding 5 bits of
+information, so that with 13 continuation bytes, we can handle 65 bits, just
+above what a 64 bit word can hold */
/* Input is a true Unicode (not-native) code point */
#define OFFUNISKIP(uv) ( (uv) < 0xA0 ? 1 : \
@@ -193,7 +206,8 @@ END_EXTERN_C
(uv) < 0x4000 ? 3 : \
(uv) < 0x40000 ? 4 : \
(uv) < 0x400000 ? 5 : \
- (uv) < 0x4000000 ? 6 : UTF8_MAXBYTES )
+ (uv) < 0x4000000 ? 6 : \
+ (uv) < 0x40000000 ? 7 : UTF8_MAXBYTES )
/* UTF-EBCDIC semantic macros - We used to transform back into I8 and then
* compare, but now only have to do a single lookup by using a bit in
@@ -221,10 +235,6 @@ END_EXTERN_C
#define isUTF8_POSSIBLY_PROBLEMATIC(c) \
_generic_isCC(c, _CC_UTF8_START_BYTE_IS_FOR_AT_LEAST_SURROGATE)
-/* Can't exceed 7 on EBCDIC platforms */
-#define UTF_START_MARK(len) (0xFF & (0xFE << (7-(len))))
-
-#define UTF_START_MASK(len) (((len) >= 6) ? 0x01 : (0x1F >> ((len)-2)))
#define UTF_CONTINUATION_MARK 0xA0
#define UTF_CONTINUATION_MASK ((U8)0x1f)
#define UTF_ACCUMULATION_SHIFT 5
View Lorry Controller Status