Hi Sadahiro
I was preoccupied with the other stuff. So i could not
respond you immediately!
For the previous four tests that were failing, I had collected the
verbose ouput and it looks like this. I had also made changes to
NATIVE_TO_UTF from NATIVE_TO_ASCII
-----------------------------------------------------------------------------------------
SWASHNEW utf8 # comment
0100 0058
0069 XXXX
00c6 XXXX
00c7 XXXX
00c8 XXXX
00c9 XXXX
00ca XXXX
00cb XXXX
00cc XXXX
006a XXXX
8 89
# => comment
CLASS = utf8, TYPE => , BITS => 8, NONE => 89
EXTRAS =>
# comment
LIST =>
0069 005a
006a 005a
00c6 005a
00c7 005a
00c8 005a
00c9 005a
00ca 005a
00cb 005a
00cc 005a
0100 0058
SWASHNEW utf8 # comment
1000 0058
0049 XXXX
00e8 XXXX
00e9 XXXX
00ea XXXX
00eb XXXX
00ec XXXX
00ed XXXX
007d XXXX
004a XXXX
8 89
# => comment
CLASS = utf8, TYPE => , BITS => 8, NONE => 89
EXTRAS =>
# comment
LIST =>
0049 005a
004a 005a
007d 005a
00e8 005a
00e9 005a
00ea 005a
00eb 005a
00ec 005a
00ed 005a
1000 0058
SWASHGET utf8=HASH(0x20f5d54c) 0 160 [/8/89]
105 => 90
105 => 90
106 => 90
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 90 90 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(0x20f5d54c) 160 32 [/8/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(0x20f5d54c) 224 32 [/8/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
# Failed at t/op/tr_new.t line 32
# got '2'
# expected '8'
# Failed at t/op/tr_new.t line 33
# got 'X–¤ó¯ÅŒX'
# expected 'XXXXXXXX'
SWASHGET utf8=HASH(0x20f772b0) 0 160 [/8/89]
73 => 90
73 => 90
74 => 90
125 => 90
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 90 90 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 90 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(0x20f772b0) 160 32 [/8/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(0x20f772b0) 224 32 [/8/89]
232 => 90
233 => 90
234 => 90
235 => 90
236 => 90
237 => 90
CELLS 89 89 89 89 89 89 89 89 90 90 90 90 90 90 89 89 89 89 89 89 89
89 89 89 89 89 89 89 89 89 89 89
# Failed at t/op/tr_new.t line 36
# got '3'
# expected '8'
# Failed at t/op/tr_new.t line 37
# got 'XËʾèíXX'
# expected 'XXXXXXXX'
# Looks like you planned 10 tests but ran 4.
1..10
105 105 90
105 105 90
106 106 90
198 198 90
198 198 90
256 256 88
not ok 1
not ok 2
73 73 90
73 73 90
74 74 90
125 125 90
232 232 90
232 232 90
232 232 90
233 233 90
234 234 90
235 235 90
236 236 90
237 237 90
4096 4096 88
not ok 3
not ok 4
---------------------------------------------------------------------------------
regards
Ravi Sastry Kadali
On 9/20/05, SADAHIRO Tomoyuki <[EMAIL PROTECTED]> wrote:
>
> On Tue, 20 Sep 2005 15:51:34 +0530, Sastry <[EMAIL PROTECTED]> wrote
>
> > Hi Sadahiro
> >
> > All the existing test suite passes. But there are couple of new tests
> > failing probably due to multibyte representation \x{1000} which is
> > represented in three byte sequence in EBCDIC . These two tests are
> >
> > $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");
> >
> > The output is:
> >
> > not ok 1
> > # Failed at t/op/tr_new.t line 32
> > # got '6'
> > # expected '8'
> > not ok 2
> > # Failed at t/op/tr_new.t line 33
> > # got 'XXXðýXXX'
> > # expected 'XXXXXXXX'
> > not ok 3
> > # Failed at t/op/tr_new.t line 36
> > # got '4'
> > # expected '8'
> > not ok 4
> > # Failed at t/op/tr_new.t line 37
> > # got 'XXôöòõXX'
> > # expected 'XXXXXXXX'
> >
> > One observation is that since this unicode appears first in the tr//
> > as there seemed a problem in \x{100} case, Seems like it doesn't
> > handle the multibyte (>2)
> >
> > regards
> > Sastry
>
> This newer patch uses NATIVE_TO_ASCII(i) instead of
> NATIVE_TO_UTF(i). This is only thing which I found being wrong
> about the prev patch; but your result seems different from my
> expectation about how the output will be with NATIVE_TO_UTF(i)
> in the prev patch...
>
> If newer patch is still wrong, would you set DEBUG
> in lib/utf8_heavy.pl to be true (that is to replace the line 5
>
> sub DEBUG () { 0 }
>
> to
>
> sub DEBUG () { 1 }
>
> and run it again? Then many verbose info will be out.
>
> 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
>
>
>
