BEGIN {
unless
(5.008 <= $]) {
print
"1..0 # skipped: Perl 5.8.0 or later needed for this test\n"
;
print
$@;
exit
;
}
if
(
$ENV
{PERL_CORE}) {
chdir
(
't'
)
if
-d
't'
;
@INC
= $^O eq
'MacOS'
?
qw(::lib)
:
qw(../lib)
;
}
}
BEGIN { $| = 1;
print
"1..90\n"
; }
my
$count
= 0;
sub
ok ($;$) {
my
$p
=
my
$r
=
shift
;
if
(
@_
) {
my
$x
=
shift
;
$p
= !
defined
$x
? !
defined
$r
: !
defined
$r
? 0 :
$r
eq
$x
;
}
print
$p
?
"ok"
:
"not ok"
,
' '
, ++
$count
,
"\n"
;
}
ok(1);
sub
_pack_U { Unicode::Collate::pack_U(
@_
) }
sub
_unpack_U { Unicode::Collate::unpack_U(
@_
) }
no
warnings
'utf8'
;
my
$entry
=
<<'ENTRIES';
FFFE ; [.0001.0020.0005.FFFE] # <noncharacter-FFFE>
FFFF ; [.FFFE.0020.0005.FFFF] # <noncharacter-FFFF>
ENTRIES
my
@disilva
= (
"di Silva"
,
"diSilva"
,
"di Si\x{301}lva"
,
"diSi\x{301}lva"
);
my
@dsf
=
map
"$_\x{FFFE}Fred"
,
@disilva
;
my
@dsj
=
map
"$_\x{FFFE}John"
,
@disilva
;
my
@dsJ
=
map
"$_ John"
,
@disilva
;
for
my
$norm
(
undef
,
'NFD'
) {
if
(
defined
$norm
) {
if
($@) {
ok(1)
for
1..34;
next
;
}
}
my
$coll
= Unicode::Collate->new(
table
=>
'keys.txt'
,
level
=> 1,
normalization
=>
$norm
,
UCA_Version
=> 22,
entry
=>
$entry
,
);
ok(
$coll
->lt(
"\x{FFFD}"
,
"\x{FFFF}"
));
ok(
$coll
->lt(
"\x{1FFFD}"
,
"\x{1FFFF}"
));
ok(
$coll
->lt(
"\x{2FFFD}"
,
"\x{2FFFF}"
));
ok(
$coll
->lt(
"\x{10FFFD}"
,
"\x{10FFFF}"
));
ok(
$coll
->lt(
"perl\x{FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{1FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{1FFFE}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{1FFFF}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{2FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{2FFFE}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{2FFFF}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{10FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{10FFFE}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{10FFFF}"
,
"perl\x{FFFF}"
));
ok(
$coll
->gt(
"perl\x{FFFF}AB"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{FFFF}\x{10FFFF}"
,
"perl\x{FFFF}\x{FFFF}"
));
$coll
->change(
level
=> 4);
for
my
$i
(0 ..
$#disilva
- 1) {
ok(
$coll
->lt(
$dsf
[
$i
],
$dsf
[
$i
+1]));
ok(
$coll
->lt(
$dsj
[
$i
],
$dsj
[
$i
+1]));
ok(
$coll
->lt(
$dsJ
[
$i
],
$dsJ
[
$i
+1]));
}
ok(
$coll
->lt(
$dsf
[-1],
$dsj
[0]));
$coll
->change(
level
=> 1);
for
my
$i
(0 ..
$#disilva
) {
ok(
$coll
->lt(
$dsf
[
$i
],
$dsJ
[
$i
]));
ok(
$coll
->lt(
$dsj
[
$i
],
$dsJ
[
$i
]));
}
}
{
my
$coll
= Unicode::Collate->new(
table
=>
'keys.txt'
,
normalization
=>
undef
,
highestFFFF
=> 1,
minimalFFFE
=> 1,
);
$coll
->change(
level
=> 1);
ok(
$coll
->lt(
"perl\x{FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{1FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{1FFFE}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{1FFFF}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{2FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{2FFFE}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{2FFFF}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{10FFFD}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{10FFFE}"
,
"perl\x{FFFF}"
));
ok(
$coll
->lt(
"perl\x{10FFFF}"
,
"perl\x{FFFF}"
));
$coll
->change(
level
=> 3);
my
@list
= (
"ab\x{FFFE}a"
,
"Ab\x{FFFE}a"
,
"ab\x{FFFE}c"
,
"Ab\x{FFFE}c"
,
"ab\x{FFFE}xyz"
,
"abc\x{FFFE}def"
,
"abc\x{FFFE}xYz"
,
"aBc\x{FFFE}xyz"
,
"abcX\x{FFFE}def"
,
"abcx\x{FFFE}xyz"
,
"b\x{FFFE}aaa"
,
"bbb\x{FFFE}a"
,
);
my
$p
=
shift
@list
;
for
my
$c
(
@list
) {
ok(
$coll
->lt(
$p
,
$c
));
$p
=
$c
;
}
}