xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/uni/fold.t (revision 0:68f95e015346)
1*0Sstevel@tonic-gateBEGIN {
2*0Sstevel@tonic-gate    chdir 't' if -d 't';
3*0Sstevel@tonic-gate    @INC = '../lib';
4*0Sstevel@tonic-gate}
5*0Sstevel@tonic-gate
6*0Sstevel@tonic-gateuse File::Spec;
7*0Sstevel@tonic-gate
8*0Sstevel@tonic-gatemy $CF = File::Spec->catfile(File::Spec->catdir(File::Spec->updir,
9*0Sstevel@tonic-gate					       "lib", "unicore"),
10*0Sstevel@tonic-gate			    "CaseFolding.txt");
11*0Sstevel@tonic-gate
12*0Sstevel@tonic-gateuse constant EBCDIC => ord 'A' == 193;
13*0Sstevel@tonic-gate
14*0Sstevel@tonic-gateif (open(CF, $CF)) {
15*0Sstevel@tonic-gate    my @CF;
16*0Sstevel@tonic-gate
17*0Sstevel@tonic-gate    while (<CF>) {
18*0Sstevel@tonic-gate	# Skip S since we are going for 'F'ull case folding
19*0Sstevel@tonic-gate        if (/^([0-9A-F]+); ([CFI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) {
20*0Sstevel@tonic-gate	    next if EBCDIC && hex $1 < 0x100;
21*0Sstevel@tonic-gate	    push @CF, [$1, $2, $3, $4];
22*0Sstevel@tonic-gate	}
23*0Sstevel@tonic-gate    }
24*0Sstevel@tonic-gate
25*0Sstevel@tonic-gate    close(CF);
26*0Sstevel@tonic-gate
27*0Sstevel@tonic-gate    die qq[$0: failed to find casefoldings from "$CF"\n] unless @CF;
28*0Sstevel@tonic-gate
29*0Sstevel@tonic-gate    print "1..", scalar @CF, "\n";
30*0Sstevel@tonic-gate
31*0Sstevel@tonic-gate    my $i = 0;
32*0Sstevel@tonic-gate    for my $cf (@CF) {
33*0Sstevel@tonic-gate	my ($code, $status, $mapping, $name) = @$cf;
34*0Sstevel@tonic-gate	$i++;
35*0Sstevel@tonic-gate	my $a = pack("U0U*", hex $code);
36*0Sstevel@tonic-gate	my $b = pack("U0U*", map { hex } split " ", $mapping);
37*0Sstevel@tonic-gate	my $t0 = ":$a:" =~ /:$a:/    ? 1 : 0;
38*0Sstevel@tonic-gate	my $t1 = ":$a:" =~ /:$a:/i   ? 1 : 0;
39*0Sstevel@tonic-gate	my $t2 = ":$a:" =~ /:[$a]:/  ? 1 : 0;
40*0Sstevel@tonic-gate	my $t3 = ":$a:" =~ /:[$a]:/i ? 1 : 0;
41*0Sstevel@tonic-gate	my $t4 = ":$a:" =~ /:$b:/i   ? 1 : 0;
42*0Sstevel@tonic-gate	my $t5 = ":$a:" =~ /:[$b]:/i ? 1 : 0;
43*0Sstevel@tonic-gate	my $t6 = ":$b:" =~ /:$a:/i   ? 1 : 0;
44*0Sstevel@tonic-gate	my $t7 = ":$b:" =~ /:[$a]:/i ? 1 : 0;
45*0Sstevel@tonic-gate	print $t0 && $t1 && $t2 && $t3 && $t4 && $t5 && $t6 && $t7 ?
46*0Sstevel@tonic-gate	    "ok $i \# - $code - $name - $mapping - $status\n" :
47*0Sstevel@tonic-gate	    "not ok $i \# - $code - $name - $mapping - $status - $t0 $t1 $t2 $t3 $t4 $t5 $t6 $t7\n";
48*0Sstevel@tonic-gate    }
49*0Sstevel@tonic-gate} else {
50*0Sstevel@tonic-gate    die qq[$0: failed to open "$CF": $!\n];
51*0Sstevel@tonic-gate}
52