Hi Sadahiro
The two test cases that were failing get passed if I use the
NATIVE_TO_ASCII() instead of NAIVE_TO_UTF()
, but surprisingly there are other two test cases that are failing now
They are
a)
($a = v300.196.172.300.196.172.400.198.144) =~
tr/\xac\xc4\x{12c}\x{190}/\xad\x{12d}\xc5\x{191}/;
is($a, v197.301.173.197.301.173.401.198.144, 'all together now!');
b)
($a = "\xfc\xfd\xfe\xff\x{100}") =~ tr/\x{1000}\x00-\xff/X/c;
is($a, "\xfc\xfd\xfe\xffX");
The output from these tests are
not ok 1 - all together now!
# Failed at t/op/tr_new.t line 41
Wide character in print at ./test.pl line 48.
# got 'Eýè«ïEýè«ï°ìFØï'
Wide character in print at ./test.pl line 48.
# expected 'Eýè[Eýè[°ìFØï'
not ok 2
# Failed at t/op/tr_new.t line 44
# got 'ýþX'
# expected 'ÜÙÚŸX'
The verbose output after enabling the DEBUG statements is
-------------------------------------------------------------------------------------------------
SWASHNEW utf8 # comment
00d6 005b
0044 012d
012c 0045
0190 0191
16 402
# => comment
CLASS = utf8, TYPE => , BITS => 16, NONE => 402
EXTRAS =>
# comment
LIST =>
0044 012d
00d6 005b
012c 0045
0190 0191
SWASHNEW utf8 # comment
0100 0058
0101 0fff XXXX
1001 7fffffff XXXX
8 89
# => comment
CLASS = utf8, TYPE => , BITS => 32, NONE => 89
EXTRAS =>
# comment
LIST =>
0100 0058
0101 0fff 005a
1001 7fffffff 005a
SWASHGET utf8=HASH(0x20f5c2e0) 288 32 [/16/402]
300 => 69
CELLS 402 402 402 402 402 402 402 402 402 402 402 402 69 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
SWASHGET utf8=HASH(0x20f5c2e0) 0 160 [/16/402]
68 => 301
CELLS 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 301 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402
SWASHGET utf8=HASH(0x20f5c2e0) 192 32 [/16/402]
214 => 91
CELLS 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 91 402 402 402 402 402 402 402 402 402
SWASHGET utf8=HASH(0x20f5c2e0) 384 32 [/16/402]
400 => 401
CELLS 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
401 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
SWASHGET utf8=HASH(0x20f5c2e0) 160 32 [/16/402]
CELLS 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
402 402 402 402 402 402 402 402 402 402 402 402 402 402 402 402
# Failed at t/op/tr_new.t line 41
Wide character in print at ./test.pl line 48.
# got 'E¯Û–ãE¯Û–㌨Føã'
Wide character in print at ./test.pl line 48.
# expected 'E¯Û[E¯Û[Œ¨Føã'
SWASHGET utf8=HASH(0x20f76034) 224 32 [/32/89]
CELLS 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89
SWASHGET utf8=HASH(0x20f76034) 0 160 [/32/89]
CELLS 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89 89
89
SWASHGET utf8=HASH(0x20f76034) 256 32 [/32/89]
256 => 88
257 => 90
258 => 90
259 => 90
260 => 90
261 => 90
262 => 90
263 => 90
264 => 90
265 => 90
266 => 90
267 => 90
268 => 90
269 => 90
270 => 90
271 => 90
272 => 90
273 => 90
274 => 90
275 => 90
276 => 90
277 => 90
278 => 90
279 => 90
280 => 90
281 => 90
282 => 90
283 => 90
284 => 90
285 => 90
286 => 90
287 => 90
CELLS 88 90 90 90 90 90 90 90 90 90 90 90 90 90 90 90 90 90 90 90 90
90 90 90 90 90 90 90 90 90 90 90
# Failed at t/op/tr_new.t line 44
# got '¯(r)ÿX'
# expected 'ðú§ÿX'
1..2
300 300 69
400 400 401
68 68 301
214 214 91
214 214 91
300 300 69
400 400 401
214 214 91
not ok 1 - all together now!
256 256 88
256 256 88
256 256 88
257 4095 90
not ok 2
---------------------------------------------------------------------------------------------------
Please see if there can be a generic change which does not effect the
other tests!
regards
Sastry
On 9/29/05, SADAHIRO Tomoyuki <[EMAIL PROTECTED]> wrote:
>
> On Thu, 29 Sep 2005 14:49:29 +0530, Sastry <[EMAIL PROTECTED]> wrote
>
> > >Thus I think these outputs reflect misusing of NATIVE_TO_UTF().
> >
> > I reconfirmed with the utfebcdic.h that the character ranges are
> > getting expanded as expected.
> > a)Is the Verbose output correct as expected?
> > b)Do you think that the NATIVE_TO_UTF() is misbehaving in which case
> > it would not have expanded the character ranges using PL_e2utf?
> >
> > regards
> > Sastry
>
> a) In my opinion, a wrong patch just brought wrong results deservedly.
> b) NATIVE_TO_UTF() is correct. My previous patch was wrong.
>
> I should use NATIVE_TO_ASCII(), but falsely used NATIVE_TO_UTF() instead.
> So I have posted a newer patch using NATIVE_TO_ASCII() to fix it.
>
> An older patch there using NATIVE_TO_UTF() is wrong:
> http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2005-09/msg00400.html
>
> A revised patch there using NATIVE_TO_ASCII().
> http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2005-09/msg00443.html
>
> I think the revised one should remove one snag, but I'm not sure whether
> all snags will be removed, because I didn't run it on EBCDIC platform.
>
> *****
> By the way, comparison between utf8.h and utfebcdic.h may suggest
> the difficulty of perl porting of Unicode issues to EBCDIC platform.
> Use of inappropriate macro will not make ASCII/UTF-8 ever unhappy,
> but will make EBCDIC/UTF-EBCDIC really unhappy...
>
> (1) from utf8.h
> /* Native character to iso-8859-1 */
> #define NATIVE_TO_ASCII(ch) (ch)
> #define ASCII_TO_NATIVE(ch) (ch)
> /* Transform after encoding */
> #define NATIVE_TO_UTF(ch) (ch)
> #define UTF_TO_NATIVE(ch) (ch)
> /* Transforms in wide UV chars */
> #define UNI_TO_NATIVE(ch) (ch)
> #define NATIVE_TO_UNI(ch) (ch)
> /* Transforms in invariant space */
> #define NATIVE_TO_NEED(enc,ch) (ch)
> #define ASCII_TO_NEED(enc,ch) (ch)
>
> (2) from utfebcdic.h
> /* Native to iso-8859-1 */
> #define NATIVE_TO_ASCII(ch) PL_e2a[(U8)(ch)]
> #define ASCII_TO_NATIVE(ch) PL_a2e[(U8)(ch)]
> /* Transform after encoding */
> #define NATIVE_TO_UTF(ch) PL_e2utf[(U8)(ch)]
> #define UTF_TO_NATIVE(ch) PL_utf2e[(U8)(ch)]
> /* Transform in wide UV char space */
> #define NATIVE_TO_UNI(ch) (((ch) > 255) ? (ch) : NATIVE_TO_ASCII(ch))
> #define UNI_TO_NATIVE(ch) (((ch) > 255) ? (ch) : ASCII_TO_NATIVE(ch))
> /* Transform in invariant..byte space */
> #define NATIVE_TO_NEED(enc,ch) ((enc) ? UTF_TO_NATIVE(NATIVE_TO_ASCII(ch))
> : (ch))
> #define ASCII_TO_NEED(enc,ch) ((enc) ? UTF_TO_NATIVE(ch) :
> ASCII_TO_NATIVE(ch))
>
> *****
>
> Well, I attach the revised patch again to make sure.
>
> Regards,
> sadahiro tomoyuki
>
>
> diff -ur [EMAIL PROTECTED]/t/op/tr.t perl/t/op/tr.t
> --- [EMAIL PROTECTED]/t/op/tr.t Thu Aug 18 18:27:25 2005
> +++ perl/t/op/tr.t Sun Sep 18 19:59:13 2005
> @@ -6,7 +6,7 @@
> require './test.pl';
> }
>
> -plan tests => 100;
> +plan tests => 120;
>
> my $Is_EBCDIC = (ord('i') == 0x89 & ord('J') == 0xd1);
>
> @@ -259,7 +259,6 @@
>
> # UTF8 range tests from Inaba Hiroto
>
> -# Not working in EBCDIC as of 12674.
> ($a = v300.196.172.302.197.172) =~ tr/\x{12c}-\x{130}/\xc0-\xc4/;
> is($a, v192.196.172.194.197.172, 'UTF range');
>
> @@ -272,6 +271,15 @@
> ($a = "\x{0100}") =~ tr/\x00-\x{100}/X/;
> is($a, "X");
>
> +($a = "\x{0100}") =~ tr/\x00-\x{101}/X/;
> +is($a, "X");
> +
> +($a = "\x{0100}\x{0101}") =~ tr/\x00-\x{102}/X/;
> +is($a, "XX");
> +
> +($a = "\x{0101}\x{0102}") =~ tr/\x00-\x{103}/X/;
> +is($a, "XX");
> +
> ($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}/X/c;
> is($a, "X");
>
> @@ -303,8 +311,16 @@
> is($c, 8);
> is($a, "XXXXXXXX");
>
> +$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/\x{1000}\x89-\x91/X/;
> +is($c, 8);
> +is($a, "XXXXXXXX");
> +
> +$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/\x{1000}\xc9-\xd1/X/;
> +is($c, 8);
> +is($a, "XXXXXXXX");
> +
> SKIP: {
> - skip "not EBCDIC", 4 unless $Is_EBCDIC;
> + skip "not EBCDIC", 12 unless $Is_EBCDIC;
>
> $c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
> is($c, 2);
> @@ -313,7 +329,38 @@
> $c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
> is($c, 2);
> is($a, "X\xca\xcb\xcc\xcd\xcf\xd0X");
> +
> + $c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/\x{1000}i-j/X/;
> + is($c, 2);
> + is($a, "X\x8a\x8b\x8c\x8d\x8f\x90X");
> +
> + $c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/\x{1000}I-J/X/;
> + is($c, 2);
> + is($a, "X\xca\xcb\xcc\xcd\xcf\xd0X");
> +
> + $c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j\x{1000}/X/;
> + is($c, 2);
> + is($a, "X\x8a\x8b\x8c\x8d\x8f\x90X");
> +
> + $c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J\x{1000}/X/;
> + is($c, 2);
> + is($a, "X\xca\xcb\xcc\xcd\xcf\xd0X");
> }
> +
> +($a = "\xfc\xfd\xfe\xff") =~ tr/\x00-\xff/X/;
> +is($a, "XXXX");
> +
> +($a = "\xfc\xfd\xfe\xff") =~ tr/\x{1000}\x00-\xff/X/;
> +is($a, "XXXX");
> +
> +($a = "\xfc\xfd\xfe\xff\x{100}") =~ tr/\x{1000}\x00-\x{100}/X/;
> +is($a, "XXXXX");
> +
> +($a = "\xfc\xfd\xfe\xff\x{100}") =~ tr/\x00-\x{200}/X/;
> +is($a, "XXXXX");
> +
> +($a = "\xfc\xfd\xfe\xff\x{100}") =~ tr/\x{1000}\x00-\xff/X/c;
> +is($a, "\xfc\xfd\xfe\xffX");
>
> ($a = "\x{100}") =~ tr/\x00-\xff/X/c;
> is(ord($a), ord("X"));
> diff -ur [EMAIL PROTECTED]/toke.c perl/toke.c
> --- [EMAIL PROTECTED]/toke.c Wed Sep 14 17:40:19 2005
> +++ perl/toke.c Tue Sep 20 23:09:13 2005
> @@ -1407,6 +1407,7 @@
> UV uv;
> #ifdef EBCDIC
> UV literal_endpoint = 0;
> + bool native_range = TRUE; /* turned to FALSE if the first endpoint is
> Unicode */
> #endif
>
> const char *leaveit = /* set of acceptably-backslashed characters */
> @@ -1429,8 +1430,14 @@
> I32 i; /* current expanded character
> */
> I32 min; /* first character in range */
> I32 max; /* last character in range */
> -
> - if (has_utf8) {
> +#ifdef EBCDIC
> + UV uvmax = 0; /* last character above byte
> */
> +#endif
> + if (has_utf8
> +#ifdef EBCDIC
> + && !native_range
> +#endif
> + ) {
> char * const c = (char*)utf8_hop((U8*)d, -1);
> char *e = d++;
> while (e-- > c)
> @@ -1443,12 +1450,45 @@
> }
>
> i = d - SvPVX_const(sv); /* remember current
> offset */
> +#ifdef EBCDIC
> + if (has_utf8) {
> + SvGROW(sv, SvLEN(sv) + 512 - UTF_CONTINUATION_MARK
> + + UNISKIP(0x100));
> + /* how many two-byte within 0..255: 128 in UTF-8, 96 in
> UTF-8-mod */
> + }
> + else {
> +#endif
> SvGROW(sv, SvLEN(sv) + 256); /* never more than 256 chars
> in a range */
> +#ifdef EBCDIC
> + }
> +#endif
> d = SvPVX(sv) + i; /* refresh d after realloc */
> - d -= 2; /* eat the first char and the
> - */
>
> +#ifdef EBCDIC
> + if (has_utf8) {
> + int j;
> + for (j = 0; j <= 1; j++) {
> + char * const c = (char*)utf8_hop((U8*)d, -1);
> + const UV uv = utf8n_to_uvchr((U8*)c, d - c, NULL,
> 0);
> + if (j)
> + min = (U8)uv;
> + else if (uv < 256)
> + max = (U8)uv;
> + else {
> + max = (U8)0xff; /* only to \xff */
> + uvmax = uv; /* \x{100} to uvmax */
> + }
> + d = c; /* eat endpoint chars */
> + }
> + }
> + else {
> +#endif
> + d -= 2; /* eat the first char and the last char */
> min = (U8)*d; /* first char in range */
> max = (U8)d[1]; /* last char in range */
> +#ifdef EBCDIC
> + }
> +#endif
>
> if (min > max) {
> Perl_croak(aTHX_
> @@ -1473,14 +1513,32 @@
> else
> #endif
> for (i = min; i <= max; i++)
> +#ifdef EBCDIC
> + if (has_utf8) {
> + const U8 ch = (U8)NATIVE_TO_ASCII(i);
> + if (UNI_IS_INVARIANT(ch))
> + *d++ = (U8)i;
> + else {
> + *d++ = (U8)UTF8_EIGHT_BIT_HI(ch);
> + *d++ = (U8)UTF8_EIGHT_BIT_LO(ch);
> + }
> + }
> + else
> +#endif
> *d++ = (char)i;
>
> +#ifdef EBCDIC
> + if (uvmax) {
> + d = (char*)uvchr_to_utf8((U8*)d, 0x100);
> + if (uvmax > 0x101)
> + *d++ = (char)UTF_TO_NATIVE(0xff);
> + if (uvmax > 0x100)
> + d = (char*)uvchr_to_utf8((U8*)d, uvmax);
> + }
> +#endif
> /* mark the range as done, and continue */
> dorange = FALSE;
> didrange = TRUE;
> -#ifdef EBCDIC
> - literal_endpoint = 0;
> -#endif
> continue;
> }
>
> @@ -1489,7 +1547,11 @@
> if (didrange) {
> Perl_croak(aTHX_ "Ambiguous range in transliteration
> operator");
> }
> - if (has_utf8) {
> + if (has_utf8
> +#ifdef EBCDIC
> + && !native_range
> +#endif
> + ) {
> *d++ = (char)UTF_TO_NATIVE(0xff); /* use illegal utf8
> byte--see pmtrans */
> s++;
> continue;
> @@ -1501,6 +1563,7 @@
> didrange = FALSE;
> #ifdef EBCDIC
> literal_endpoint = 0;
> + native_range = TRUE;
> #endif
> }
> }
> @@ -1705,6 +1768,10 @@
> (PL_lex_repl ? OPpTRANS_FROM_UTF
> : OPpTRANS_TO_UTF);
> }
> +#ifdef EBCDIC
> + if (uv > 255 && !dorange)
> + native_range = FALSE;
> +#endif
> }
> else {
> *d++ = (char)uv;
> @@ -1782,6 +1849,10 @@
> SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
> d = SvPVX(sv) + (d - odest);
> }
> +#ifdef EBCDIC
> + if (!dorange)
> + native_range = FALSE; /* \N{} is guessed to be
> Unicode */
> +#endif
> Copy(str, d, len, char);
> d += len;
> SvREFCNT_dec(res);
> @@ -1855,6 +1926,10 @@
> }
> d = (char*)uvchr_to_utf8((U8*)d, uv);
> has_utf8 = TRUE;
> +#ifdef EBCDIC
> + if (uv > 255 && !dorange)
> + native_range = FALSE;
> +#endif
> }
> else {
> *d++ = NATIVE_TO_NEED(has_utf8,*s++);
> ###END OF PATCH
>
>
>
