In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e71417e415af4699d56467e02c623bdc01a490cd?hp=227e818e7f550517639af67457b5de16e61ffc11>
- Log ----------------------------------------------------------------- commit e71417e415af4699d56467e02c623bdc01a490cd Author: Karl Williamson <[email protected]> Date: Mon Nov 24 11:22:00 2014 -0700 charnames: More fix to work on EBCDIC. This adds a couple of fixes omitted from 27c3afbd6068ac83b49a11df3e33758ef059027e. M lib/charnames.pm commit 4ed038e9a620a34a71039c10c46e7b759a26891c Author: Karl Williamson <[email protected]> Date: Mon Nov 24 11:19:03 2014 -0700 t/test.pl: Fix for non-ASCII platforms M t/test.pl commit 3ece276e6c082406cbccdc9ccbbd3a6fb3f91bf6 Author: Karl Williamson <[email protected]> Date: Mon Nov 24 14:58:47 2014 -0700 pp_pack.c: Make pack('U', 0x41) eq 'A' The 'U' pack/unpack format must be in terms of Unicode code points. M pp_pack.c commit 99f862a1794060158d563eeb2ff6fe74e048b394 Author: Karl Williamson <[email protected]> Date: Mon Nov 24 14:57:02 2014 -0700 pp_pack.c: Add comment M pp_pack.c commit 1b413590aa73b1cc630b6712d7695fac54d03828 Author: Karl Williamson <[email protected]> Date: Wed Nov 12 12:53:50 2014 -0700 Improve EBCDIC skip msgs in t/uni Add more explanation as to why they are skipped M t/uni/chr.t M t/uni/greek.t M t/uni/latin2.t M t/uni/tr_7jis.t M t/uni/tr_eucjp.t M t/uni/tr_sjis.t M t/uni/tr_utf8.t ----------------------------------------------------------------------- Summary of changes: lib/charnames.pm | 4 ++-- pp_pack.c | 16 +++++++++++----- t/test.pl | 2 +- t/uni/chr.t | 2 +- t/uni/greek.t | 2 +- t/uni/latin2.t | 2 +- t/uni/tr_7jis.t | 2 +- t/uni/tr_eucjp.t | 2 +- t/uni/tr_sjis.t | 2 +- t/uni/tr_utf8.t | 2 +- 10 files changed, 21 insertions(+), 15 deletions(-) diff --git a/lib/charnames.pm b/lib/charnames.pm index 28e0282..2efe3d5 100644 --- a/lib/charnames.pm +++ b/lib/charnames.pm @@ -49,7 +49,7 @@ sub vianame # can't change it because of backward compatibility. New code can use # string_vianame() instead. my $ord = CORE::hex $1; - return chr $ord if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits); + return pack("U", $ord) if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits); _charnames::carp _charnames::not_legal_use_bytes_msg($arg, chr $ord); return; } @@ -74,7 +74,7 @@ sub string_vianame { if ($arg =~ /^U\+([0-9a-fA-F]+)$/) { my $ord = CORE::hex $1; - return chr $ord if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits); + return pack("U", $ord) if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits); _charnames::carp _charnames::not_legal_use_bytes_msg($arg, chr $ord); return; diff --git a/pp_pack.c b/pp_pack.c index 40db6ef..eb63db9 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -1318,10 +1318,16 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c len = UTF8SKIP(result); if (!uni_to_bytes(aTHX_ &ptr, strend, (char *) &result[1], len-1, 'U')) break; - auv = utf8n_to_uvchr(result, len, &retlen, UTF8_ALLOW_DEFAULT); + auv = NATIVE_TO_UNI(utf8n_to_uvchr(result, + len, + &retlen, + UTF8_ALLOW_DEFAULT)); s = ptr; } else { - auv = utf8n_to_uvchr((U8*)s, strend - s, &retlen, UTF8_ALLOW_DEFAULT); + auv = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, + strend - s, + &retlen, + UTF8_ALLOW_DEFAULT)); if (retlen == (STRLEN) -1 || retlen == 0) Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); s += retlen; @@ -1792,7 +1798,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c if (!checksum) XPUSHs(sv); break; - } + } /* End of switch */ if (checksum) { if (strchr("fFdD", TYPE_NO_MODIFIERS(datumtype)) || @@ -2666,7 +2672,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) auv = SvUV_no_inf(fromstr, datumtype); if (utf8) { U8 buffer[UTF8_MAXLEN], *endb; - endb = uvchr_to_utf8_flags(buffer, auv, + endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv), warn_utf8 ? 0 : UNICODE_ALLOW_ANY); if (cur+(endb-buffer)*UTF8_EXPAND >= end) { @@ -2684,7 +2690,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) GROWING(0, cat, start, cur, len+UTF8_MAXLEN); end = start+SvLEN(cat)-UTF8_MAXLEN; } - cur = (char *) uvchr_to_utf8_flags((U8 *) cur, auv, + cur = (char *) uvchr_to_utf8_flags((U8 *) cur, UNI_TO_NATIVE(auv), warn_utf8 ? 0 : UNICODE_ALLOW_ANY); } diff --git a/t/test.pl b/t/test.pl index a4cc2d6..1d08f55 100644 --- a/t/test.pl +++ b/t/test.pl @@ -295,7 +295,7 @@ sub display { foreach my $x (@_) { if (defined $x and not ref $x) { my $y = ''; - foreach my $c (unpack("U*", $x)) { + foreach my $c (unpack("W*", $x)) { if ($c > 255) { $y = $y . sprintf "\\x{%x}", $c; } elsif ($backslash_escape{$c}) { diff --git a/t/uni/chr.t b/t/uni/chr.t index 321e828..390cdb1 100644 --- a/t/uni/chr.t +++ b/t/uni/chr.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } diff --git a/t/uni/greek.t b/t/uni/greek.t index 9295e6f..7d73ecb 100644 --- a/t/uni/greek.t +++ b/t/uni/greek.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } diff --git a/t/uni/latin2.t b/t/uni/latin2.t index aacc131..ba67e09 100644 --- a/t/uni/latin2.t +++ b/t/uni/latin2.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } diff --git a/t/uni/tr_7jis.t b/t/uni/tr_7jis.t index 9bedaaa..d1735f9 100644 --- a/t/uni/tr_7jis.t +++ b/t/uni/tr_7jis.t @@ -8,7 +8,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } diff --git a/t/uni/tr_eucjp.t b/t/uni/tr_eucjp.t index 99ae2fd..c5cccfa 100644 --- a/t/uni/tr_eucjp.t +++ b/t/uni/tr_eucjp.t @@ -7,7 +7,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } diff --git a/t/uni/tr_sjis.t b/t/uni/tr_sjis.t index 84a9ca5..fec525d 100644 --- a/t/uni/tr_sjis.t +++ b/t/uni/tr_sjis.t @@ -7,7 +7,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } diff --git a/t/uni/tr_utf8.t b/t/uni/tr_utf8.t index ee96e8b..59782f1 100644 --- a/t/uni/tr_utf8.t +++ b/t/uni/tr_utf8.t @@ -8,7 +8,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; skip_all_without_dynamic_extension('Encode'); - skip_all("EBCDIC") if $::IS_EBCDIC; + skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } -- Perl5 Master Repository
