Fresco/Babylon/test ucd.pl,1.3,1.4
Tobias Hunger <[email protected]> Wed, 28 Jan 2004 16:23:49 +0100
| Newsgroups | gmane.comp.video.fresco.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvs/fresco/Fresco/Babylon/test
In directory purcel:/tmp/cvs-serv2332/test
Modified Files:
ucd.pl
Log Message:
Fix is_Private_Use() bug discovered by cow and add a test for this problem.
Index: ucd.pl
===================================================================
RCS file: /cvs/fresco/Fresco/Babylon/test/ucd.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- ucd.pl 29 Dec 2003 08:42:48 -0000 1.3
+++ ucd.pl 28 Jan 2004 15:22:37 -0000 1.4
@@ -8,7 +8,8 @@
my @registered_tests = ("test_ucd", "test_blocks", "test_linebreak",
"test_eawidth", "test_compexclude",
"test_properties", "test_coreproperties",
- "test_normalize", "test_unlisted_norms");
+ "test_normalize", "test_unlisted_norms",
+ "test_private_use");
$MAKE_TOP_BUILDDIR = "@MAKE_TOP_BUILDDIR@";
$dump_ucd = "$MAKE_TOP_BUILDDIR/bin/dump_ucd $MAKE_TOP_BUILDDIR/modules";
@@ -85,55 +86,55 @@
unless (open UCD, "./$unicode_ucd")
{
- abort("Can't open '$unicode_ucd'",
- "Error opening file '$unicode_ucd'.");
- return;
+ abort("Can't open '$unicode_ucd'",
+ "Error opening file '$unicode_ucd'.");
+ return;
}
unless (open BABYLON, "$dump_ucd |")
{
- abort("Can't find dump_ucd demo.", "Error opening pipe.");
- return;
+ abort("Can't find dump_ucd demo.", "Error opening pipe.");
+ return;
}
my $diff = " NOTHING COMPARED.";
while(<UCD>)
{
- next if /^$/;
- # remove comments and names from UCD file, eval digit values:
- my @parts = split ';', strip_WS($_), 15;
- $parts[1] = "";
- if ($parts[6] ne "") { $parts[6] = sprintf "%.6f", eval "$parts[6]"; }
- if ($parts[7] ne "") { $parts[7] = sprintf "%.6f", eval "$parts[7]"; }
- if ($parts[8] ne "") { $parts[8] = sprintf "%.6f", eval "$parts[8]"; }
- $parts[10] = "";
- $parts[11] = "";
- if ($parts[12] eq $parts[0]) { $parts[12] = ""; }
- if ($parts[13] eq $parts[0]) { $parts[13] = ""; }
- if ($parts[14] eq $parts[0]) { $parts[14] = ""; }
- my $ucd_line = strip_WS(join ";", @parts);
- next unless ($ucd_line);
-
- # get line from dump:
- my $babylon_line = <BABYLON>;
- $babylon_line = strip_WS($babylon_line);
-
- # compare
- if ($ucd_line ne $babylon_line)
- {
- $diff = " UCD : '$ucd_line'\n BABYLON: '$babylon_line'";
- last;
- }
- $diff = "";
+ next if /^$/;
+ # remove comments and names from UCD file, eval digit values:
+ my @parts = split ';', strip_WS($_), 15;
+ $parts[1] = "";
+ if ($parts[6] ne "") { $parts[6] = sprintf "%.6f", eval "$parts[6]"; }
+ if ($parts[7] ne "") { $parts[7] = sprintf "%.6f", eval "$parts[7]"; }
+ if ($parts[8] ne "") { $parts[8] = sprintf "%.6f", eval "$parts[8]"; }
+ $parts[10] = "";
+ $parts[11] = "";
+ if ($parts[12] eq $parts[0]) { $parts[12] = ""; }
+ if ($parts[13] eq $parts[0]) { $parts[13] = ""; }
+ if ($parts[14] eq $parts[0]) { $parts[14] = ""; }
+ my $ucd_line = strip_WS(join ";", @parts);
+ next unless ($ucd_line);
+
+ # get line from dump:
+ my $babylon_line = <BABYLON>;
+ $babylon_line = strip_WS($babylon_line);
+
+ # compare
+ if ($ucd_line ne $babylon_line)
+ {
+ $diff = " UCD : '$ucd_line'\n BABYLON: '$babylon_line'";
+ last;
+ }
+ $diff = "";
}
close BABYLON;
close UCD;
-
+
pass() unless ($diff);
fail("dump_ucd output differs from the file downloaded.",
- "First difference:\n$diff") if ($diff);
+ "First difference:\n$diff") if ($diff);
}
@@ -145,37 +146,37 @@
unless (open UCD, $unicode_blocks)
{
- abort("Can't open $unicode_blocks",
- "Error opening file $unicode_blocks");
- return;
+ abort("Can't open $unicode_blocks",
+ "Error opening file $unicode_blocks");
+ return;
}
-
+
unless (open BABYLON, "$dump_blocks |")
{
- abort("Can't find dump_blocks demo.", "Error opening pipe.");
- return;
+ abort("Can't find dump_blocks demo.", "Error opening pipe.");
+ return;
}
-
+
my $diff = " NOTHING COMPARED.";
while(<UCD>)
{
- # remove comments
- my $block_line = strip_WS($_);
- $block_line =~ s/#.*$//;
- next unless ($block_line);
-
- # get line from dump:
- my $babylon_line = <BABYLON>;
- $babylon_line = strip_WS($babylon_line);
-
- # compare
- if ($block_line ne $babylon_line)
- {
- $diff = " UCD : '$block_line'\n BABYLON: '$babylon_line'";
- last;
- }
- $diff = "";
+ # remove comments
+ my $block_line = strip_WS($_);
+ $block_line =~ s/#.*$//;
+ next unless ($block_line);
+
+ # get line from dump:
+ my $babylon_line = <BABYLON>;
+ $babylon_line = strip_WS($babylon_line);
+
+ # compare
+ if ($block_line ne $babylon_line)
+ {
+ $diff = " UCD : '$block_line'\n BABYLON: '$babylon_line'";
+ last;
+ }
+ $diff = "";
}
close BABYLON;
@@ -183,7 +184,7 @@
pass() unless ($diff);
fail("dump_blocks output differs from the file downloaded.",
- "First difference:\n$diff") if ($diff);
+ "First difference:\n$diff") if ($diff);
}
@@ -195,37 +196,37 @@
unless (open UCD, $unicode_lb)
{
- abort("Can't open $unicode_lb", "Error opening file $unicode_lb");
- return;
+ abort("Can't open $unicode_lb", "Error opening file $unicode_lb");
+ return;
}
-
+
unless (open BABYLON, "$dump_lb |")
{
- abort("Can't find dump_lb demo.", "Error opening pipe.");
- return;
+ abort("Can't find dump_lb demo.", "Error opening pipe.");
+ return;
}
-
+
my $diff = " NOTHING COMPARED.";
while(<UCD>)
{
- # remove comments
- my $lb_line = strip_WS($_);
- $lb_line =~ s/#.*$//;
- $lb_line = strip_WS($lb_line);
- next unless ($lb_line);
-
- # get line from dump:
- my $babylon_line = <BABYLON>;
- $babylon_line = strip_WS($babylon_line);
-
- # compare
- if ($lb_line ne $babylon_line)
- {
- $diff = " UCD : '$lb_line'\n BABYLON: '$babylon_line'";
- last;
- }
- $diff = "";
+ # remove comments
+ my $lb_line = strip_WS($_);
+ $lb_line =~ s/#.*$//;
+ $lb_line = strip_WS($lb_line);
+ next unless ($lb_line);
+
+ # get line from dump:
+ my $babylon_line = <BABYLON>;
+ $babylon_line = strip_WS($babylon_line);
+
+ # compare
+ if ($lb_line ne $babylon_line)
+ {
+ $diff = " UCD : '$lb_line'\n BABYLON: '$babylon_line'";
+ last;
+ }
+ $diff = "";
}
close BABYLON;
@@ -233,7 +234,7 @@
pass() unless ($diff);
fail("dump_lb output differs from the file downloaded.",
- "First difference:\n$diff") if ($diff);
+ "First difference:\n$diff") if ($diff);
}
@@ -245,64 +246,64 @@
unless (open UCD, $unicode_ea)
{
- abort("Can't open $unicode_ea", "Error opening file $unicode_ea");
- return;
+ abort("Can't open $unicode_ea", "Error opening file $unicode_ea");
+ return;
}
-
+
unless (open BABYLON, "$dump_ea |")
{
- abort("Can't find dump_ea demo.", "Error opening pipe.");
- return;
+ abort("Can't find dump_ea demo.", "Error opening pipe.");
+ return;
}
my %eawidth;
while(<UCD>)
{
- if (/([A-F0-9]+)\.\.([A-F0-9]+);([A-Za-z]+)/)
- {
- for (my $i = hex($1); $i <= hex($2); $i++)
+ if (/([A-F0-9]+)\.\.([A-F0-9]+);([A-Za-z]+)/)
{
- $eawidth{$i} = $3;
+ for (my $i = hex($1); $i <= hex($2); $i++)
+ {
+ $eawidth{$i} = $3;
+ }
+ next;
+ }
+ if (/^([A-F0-9]+);([A-Za-z]+)/)
+ {
+ $eawidth{hex($1)} = $3;
+ next;
}
- next;
- }
- if (/^([A-F0-9]+);([A-Za-z]+)/)
- {
- $eawidth{hex($1)} = $3;
- next;
- }
}
while(<BABYLON>)
{
- chop;
- if (/^([A-F0-9]+);([A-Za-z]+)/)
- {
- $eawidth{hex($1)} .= ":$2";
- }
+ chop;
+ if (/^([A-F0-9]+);([A-Za-z]+)/)
+ {
+ $eawidth{hex($1)} .= ":$2";
+ }
}
-
+
close BABYLON;
close UCD;
-
+
my $diff_str = " UCD BABYLON\n --------------------\n";
my $diff = 0;
-
+
# compute diff:
foreach my $item (sort numerically keys %eawidth)
{
- if ($eawidth{$item} =~ /([A-Za-z]+):([A-Za-z]+)/)
- {
- $diff = 1 if ($1 ne $2);
- $diff_str .= sprintf " %8X\n", $item if ($1 eq "");
- $diff_str .= sprintf " %8X\n", $item if ($2 eq "");
- }
+ if ($eawidth{$item} =~ /([A-Za-z]+):([A-Za-z]+)/)
+ {
+ $diff = 1 if ($1 ne $2);
+ $diff_str .= sprintf " %8X\n", $item if ($1 eq "");
+ $diff_str .= sprintf " %8X\n", $item if ($2 eq "");
+ }
}
-
+
pass() unless ($diff);
fail("dump_ea output differs from the file downloaded.",
- "First difference:\n$diff_str") if ($diff);
+ "First difference:\n$diff_str") if ($diff);
}
@@ -314,46 +315,46 @@
unless (open UCD, $unicode_compexclude)
{
- abort("Can't open $unicode_compexclude",
- "Error opening file $unicode_compexclude");
- return;
+ abort("Can't open $unicode_compexclude",
+ "Error opening file $unicode_compexclude");
+ return;
}
-
+
unless (open BABYLON, "$dump_compexclude |")
{
- abort("Can't find dump_compexclude demo.", "Error opening pipe.");
- return;
+ abort("Can't find dump_compexclude demo.", "Error opening pipe.");
+ return;
}
-
+
my %exclude;
-
+
while(<UCD>)
{
- if (/^(\# )?([A-F0-9]+)\.\.([A-F0-9]+)\s/)
- {
- for (my $i = hex($2); $i <= hex($3); $i++)
+ if (/^(\# )?([A-F0-9]+)\.\.([A-F0-9]+)\s/)
{
- $exclude{$i} = "UCD" unless ($1);
- $exclude{$i} = "*UCD" if ($1);
+ for (my $i = hex($2); $i <= hex($3); $i++)
+ {
+ $exclude{$i} = "UCD" unless ($1);
+ $exclude{$i} = "*UCD" if ($1);
+ }
+ next;
+ }
+ if (/^(\# )?([A-F0-9]+)\s/)
+ {
+ $exclude{hex($2)} = "UCD" unless ($1);
+ $exclude{hex($2)} = "*UCD" if ($1);
+ next;
}
- next;
- }
- if (/^(\# )?([A-F0-9]+)\s/)
- {
- $exclude{hex($2)} = "UCD" unless ($1);
- $exclude{hex($2)} = "*UCD" if ($1);
- next;
- }
}
while(<BABYLON>)
{
- chop;
- if (/^(\# )?([A-F0-9]+)/)
- {
- $exclude{hex($2)} .= "BABYLON" unless ($1);
- $exclude{hex($2)} .= "BABYLON*" if ($1);
- }
+ chop;
+ if (/^(\# )?([A-F0-9]+)/)
+ {
+ $exclude{hex($2)} .= "BABYLON" unless ($1);
+ $exclude{hex($2)} .= "BABYLON*" if ($1);
+ }
}
close BABYLON;
@@ -361,39 +362,39 @@
my $diff_str = " UCD BABYLON\n --------------------\n";
my $diff = 0;
-
+
# compute diff:
foreach my $item (sort numerically keys %exclude)
{
- if ($exclude{$item} eq "UCD")
- {
- $diff_str .= sprintf " %8X\n", $item;
- $diff = 1;
- next;
- }
- if ($exclude{$item} eq "*UCD")
- {
- $diff_str .= sprintf " #%8X\n", $item;
- $diff = 1;
- next;
- }
- if ($exclude{$item} eq "BABYLON")
- {
- $diff_str .= sprintf " %8X\n", $item;
- $diff = 1;
- next;
- }
- if ($exclude{$item} eq "BABYLON*")
- {
- $diff_str .= sprintf " #%8X\n", $item;
- $diff = 1;
- next;
- }
+ if ($exclude{$item} eq "UCD")
+ {
+ $diff_str .= sprintf " %8X\n", $item;
+ $diff = 1;
+ next;
+ }
+ if ($exclude{$item} eq "*UCD")
+ {
+ $diff_str .= sprintf " #%8X\n", $item;
+ $diff = 1;
+ next;
+ }
+ if ($exclude{$item} eq "BABYLON")
+ {
+ $diff_str .= sprintf " %8X\n", $item;
+ $diff = 1;
+ next;
+ }
+ if ($exclude{$item} eq "BABYLON*")
+ {
+ $diff_str .= sprintf " #%8X\n", $item;
+ $diff = 1;
+ next;
+ }
}
-
+
pass() unless ($diff);
fail("dump_compexclude output differs from the file downloaded.",
- "Difference:\n$diff_str") if ($diff);
+ "Difference:\n$diff_str") if ($diff);
}
sub properties_compare
@@ -401,35 +402,35 @@
my $prop = shift;
my $data = shift;
my $results = shift;
-
+
unless (open BABYLON, "$dump_props $prop |")
{
- abort("Can't find dump_props demo.", "Error opening pipe.");
- return;
+ abort("Can't find dump_props demo.", "Error opening pipe.");
+ return;
}
-
+
while (<BABYLON>)
{
- chop;
- $data->{hex($_)} .= "BABYLON" if (/^([A-F0-9]+)$/);
+ chop;
+ $data->{hex($_)} .= "BABYLON" if (/^([A-F0-9]+)$/);
}
close BABYLON;
-
+
# compute diff:
my $diff_str = " $prop:\n";
foreach my $item (sort numerically keys %$data)
{
- if ($data->{$item} eq $prop)
- {
- $diff_str .= sprintf " %8X\n", $item;
- next;
- }
- if ($data->{$item} eq "BABYLON")
- {
- $diff_str .= sprintf " %8X\n", $item;
- next;
- }
- # $diff_str .= sprintf " %8X--%8X\n", $item, $item;
+ if ($data->{$item} eq $prop)
+ {
+ $diff_str .= sprintf " %8X\n", $item;
+ next;
+ }
+ if ($data->{$item} eq "BABYLON")
+ {
+ $diff_str .= sprintf " %8X\n", $item;
+ next;
+ }
+ # $diff_str .= sprintf " %8X--%8X\n", $item, $item;
}
$results->{$prop} = $diff_str;
}
@@ -442,77 +443,84 @@
unless (open UCD, $unicode_props)
{
- abort("Can't open $unicode_props",
- "Error opening file $unicode_props");
- return;
+ abort("Can't open $unicode_props",
+ "Error opening file $unicode_props");
+ return;
}
-
+
my %prop;
my %results;
my $current_prop = "";
-
+
while(<UCD>)
{
chop:
- if (/^([A-F0-9]+)\.\.([A-F0-9]+)\s*; ([A-Za-z_]+)/)
- {
- if ($current_prop && $3 ne $current_prop)
- {
- properties_compare($current_prop, \%prop, \%results);
- %prop = ();
- }
- $current_prop = $3;
- for (my $i = hex($1); $i <= hex($2); $i++)
+ if (/^([A-F0-9]+)\.\.([A-F0-9]+)\s*; ([A-Za-z_]+)/)
{
- $prop{$i} = $current_prop;
+ if ($current_prop && $3 ne $current_prop)
+ {
+ properties_compare($current_prop, \%prop, \%results);
+ %prop = ();
+ }
+ $current_prop = $3;
+ for (my $i = hex($1); $i <= hex($2); $i++)
+ {
+ $prop{$i} = $current_prop;
+ }
+ next;
}
- next;
- }
- if (/^([A-F0-9]+)\s*; ([A-Za-z_]+)/)
- {
- if ($current_prop && $2 ne $current_prop)
+ if (/^([A-F0-9]+)\s*; ([A-Za-z_]+)/)
{
- properties_compare($current_prop, \%prop, \%results);
- %prop = ();
+ if ($current_prop && $2 ne $current_prop)
+ {
+ properties_compare($current_prop, \%prop, \%results);
+ %prop = ();
+ }
+ $current_prop = $2;
+ $prop{hex($1)} = $current_prop;
+ next;
}
- $current_prop = $2;
- $prop{hex($1)} = $current_prop;
- next;
- }
}
close UCD;
+ calculate_results(\%results);
+}
+
+sub calculate_results
+{
+ my $results = shift;
+
my $diff = 0;
my $diff_str = " UCD BABYLON\n --------------------\n";
# calculate results:
foreach my $item (sort keys %results)
{
- if ($results{$item} eq " $item:\n")
- {
- $diff_str .= " $item: no difference.\n";
- next;
- }
-
- $diff = 1;
- $diff_str .= $results{$item};
-
- if ($results{$item} eq $item)
- {
- $diff_str .= sprintf " %8X\n", $item;
- next;
- }
- if ($results{$item} eq "BABYLON")
- {
- $diff_str .= sprintf " %8X\n", $item;
- next;
- }
+ if ($results{$item} eq " $item:\n")
+ {
+ $diff_str .= " $item: no difference.\n";
+ next;
+ }
+
+ $diff = 1;
+ $diff_str .= $results{$item};
+
+ if ($results{$item} eq $item)
+ {
+ $diff_str .= sprintf " %8X\n", $item;
+ next;
+ }
+ if ($results{$item} eq "BABYLON")
+ {
+ $diff_str .= sprintf " %8X\n", $item;
+ next;
+ }
}
-
+
pass() unless ($diff);
fail("dump_props output differs from the file downloaded.",
- "Difference:\n$diff_str") if ($diff);
+ "Difference:\n$diff_str") if ($diff);
}
sub test_properties
@@ -525,6 +533,29 @@
properties_tester("DerivedCoreProperties.txt");
}
+sub test_private_use
+{
+ my $prop = "Private_Use";
+ my %data;
+ my %results;
+
+ for (my $i = 0xE000; $i <= 0xF8FF; $i++)
+ {
+ $data{$i} = $prop;
+ }
+ for ($i = 0xF0000; $i <= 0xFFFFD; $i++)
+ {
+ $data{$i} = $prop;
+ }
+ for ($i = 0x100000; $i <= 0x10FFFD; $i++)
+ {
+ $data{$i} = $prop;
+ }
+
+ properties_compare($prop, \%data, \%results);
+ calculate_results(\%results);
+}
+
sub test_normalize
{
my $unicode_normalize = "NormalizationTest.txt";
@@ -533,89 +564,89 @@
unless (open UCD, $unicode_normalize)
{
- abort("Can't open $unicode_normalize",
+ abort("Can't open $unicode_normalize",
"Error opening file $unicode_normalize");
- return;
+ return;
}
my $pid;
unless ($pid = open2( \*Reader, \*Writer, "$normalize"))
{
- abort("Can't open pipes to $normalize", "Error opening pipes.");
- return;
+ abort("Can't open pipes to $normalize", "Error opening pipes.");
+ return;
}
-
+
my $diff = "";
my $nok = 0;
my $total = 0;
-
- while(<UCD>)
- {
- my $orig = $_;
- $orig =~ s/# \(.*\) (.*)\n$/# $1/;
-
- s/\s*#.*$//;
-
- next unless (/^[A-F0-9 ]+;[A-F0-9 ]+;[A-F0-9 ]+;[A-F0-9 ]+;[A-F0-9 ]+;/);
-
- $total++;
- my @c = split /;/, $_, 6;
- print Writer "n$c[0]\n"; my @c1 = split /;/, <Reader>, 6;
- print Writer "c$c[1]\n"; my @c2 = split /;/, <Reader>, 6;
- print Writer "d$c[2]\n"; my @c3 = split /;/, <Reader>, 6;
- print Writer "kc$c[3]\n"; my @c4 = split /;/, <Reader>, 6;
- print Writer "kd$c[4]\n"; my @c5 = split /;/, <Reader>, 6;
-
- if ( # NFD
- ($c[2] ne $c1[2]) || ($c[2] ne $c2[2]) || ($c[2] ne $c3[2]) ||
- ($c[4] ne $c4[2]) || ($c[4] ne $c5[2]) )
- {
- $nok++;
- $diff .= " $orig (NFD wrong)\n";
- $diff .= " c3>$c[2]< == D(c1)>$c1[2]< == D(c2)>$c2[2]< == D(c3)>$c3[2]<\n";
- $diff .= " c5>$c[4]< == D(c4)>$c4[2]< == D(c5)>$c5[2]<\n";
-
- }
- elsif ( # NFKC
- ($c[3] ne $c1[3]) || ($c[3] ne $c2[3]) || ($c[3] ne $c3[3]) ||
- ($c[3] ne $c4[3]) || ($c[3] ne $c5[3]) )
- {
- $nok++;
- $diff .= " $orig (NFKC wrong)\n";
- $diff .= " c4>$c[3]< == KC(c1)>$c1[3]< == KC(c2)>$c2[3]< == KC(c3)>$c3[3]< == KC(c4)>$c4[3]< == KC(c5)>$c5[3]<\n";
- }
- elsif ( # NFC
- ($c[1] ne $c1[1]) || ($c[1] ne $c2[1]) || ($c[1] ne $c3[1]) ||
- ($c[3] ne $c4[1]) || ($c[3] ne $c5[1]) )
- {
- $nok++;
- $diff .= " $orig (NFC wrong)\n";
- $diff .= " c2>$c[1]< == C(c1)>$c1[1]< == C(c2)>$c2[1]< == C(c3)>$c3[1]<\n";
- $diff .= " c4>$c[3]< == C(c4)>$c4[1]< == C(c5)>$c5[1]<\n";
- }
- elsif ( # NFKC
- ($c[3] ne $c1[3]) || ($c[3] ne $c2[3]) || ($c[3] ne $c3[3]) ||
- ($c[3] ne $c4[3]) || ($c[3] ne $c5[3]) )
- {
- $nok++;
- $diff .= " $orig (NFKC wrong)\n";
- $diff .= " c4>$c[3]< == KC(c1)>$c1[3]< == KC(c2)>$c2[3]< == KC(c3)>$c3[3]< == KC(c4)>$c4[3]< == KC(c5)>$c5[3]<\n";
- }
- if ($diff)
+ while(<UCD>)
{
- print "-- $orig\n";
- print $diff;
- exit 11;
- }
+ my $orig = $_;
+ $orig =~ s/# \(.*\) (.*)\n$/# $1/;
+
+ s/\s*#.*$//;
+
+ next unless (/^[A-F0-9 ]+;[A-F0-9 ]+;[A-F0-9 ]+;[A-F0-9 ]+;[A-F0-9 ]+;/);
+
+ $total++;
+
+ my @c = split /;/, $_, 6;
+ print Writer "n$c[0]\n"; my @c1 = split /;/, <Reader>, 6;
+ print Writer "c$c[1]\n"; my @c2 = split /;/, <Reader>, 6;
+ print Writer "d$c[2]\n"; my @c3 = split /;/, <Reader>, 6;
+ print Writer "kc$c[3]\n"; my @c4 = split /;/, <Reader>, 6;
+ print Writer "kd$c[4]\n"; my @c5 = split /;/, <Reader>, 6;
+
+ if ( # NFD
+ ($c[2] ne $c1[2]) || ($c[2] ne $c2[2]) || ($c[2] ne $c3[2]) ||
+ ($c[4] ne $c4[2]) || ($c[4] ne $c5[2]) )
+ {
+ $nok++;
+ $diff .= " $orig (NFD wrong)\n";
+ $diff .= " c3>$c[2]< == D(c1)>$c1[2]< == D(c2)>$c2[2]< == D(c3)>$c3[2]<\n";
+ $diff .= " c5>$c[4]< == D(c4)>$c4[2]< == D(c5)>$c5[2]<\n";
+
+ }
+ elsif ( # NFKC
+ ($c[3] ne $c1[3]) || ($c[3] ne $c2[3]) || ($c[3] ne $c3[3]) ||
+ ($c[3] ne $c4[3]) || ($c[3] ne $c5[3]) )
+ {
+ $nok++;
+ $diff .= " $orig (NFKC wrong)\n";
+ $diff .= " c4>$c[3]< == KC(c1)>$c1[3]< == KC(c2)>$c2[3]< == KC(c3)>$c3[3]< == KC(c4)>$c4[3]< == KC(c5)>$c5[3]<\n";
+ }
+ elsif ( # NFC
+ ($c[1] ne $c1[1]) || ($c[1] ne $c2[1]) || ($c[1] ne $c3[1]) ||
+ ($c[3] ne $c4[1]) || ($c[3] ne $c5[1]) )
+ {
+ $nok++;
+ $diff .= " $orig (NFC wrong)\n";
+ $diff .= " c2>$c[1]< == C(c1)>$c1[1]< == C(c2)>$c2[1]< == C(c3)>$c3[1]<\n";
+ $diff .= " c4>$c[3]< == C(c4)>$c4[1]< == C(c5)>$c5[1]<\n";
+ }
+ elsif ( # NFKC
+ ($c[3] ne $c1[3]) || ($c[3] ne $c2[3]) || ($c[3] ne $c3[3]) ||
+ ($c[3] ne $c4[3]) || ($c[3] ne $c5[3]) )
+ {
+ $nok++;
+ $diff .= " $orig (NFKC wrong)\n";
+ $diff .= " c4>$c[3]< == KC(c1)>$c1[3]< == KC(c2)>$c2[3]< == KC(c3)>$c3[3]< == KC(c4)>$c4[3]< == KC(c5)>$c5[3]<\n";
+ }
+ if ($diff)
+ {
+ print "-- $orig\n";
+ print $diff;
+ exit 11;
+ }
}
close *Reader;
close *Writer;
close UCD;
-
+
pass() unless ($diff);
fail("normalize output differs from the file downloaded.",
- "First difference:\n$diff\n Total: $total, not OK: $nok\n") if ($diff);
+ "First difference:\n$diff\n Total: $total, not OK: $nok\n") if ($diff);
}
sub test_unlisted_norms
@@ -626,60 +657,61 @@
unless (open UCD, $unicode_normalize)
{
- abort("Can't open $unicode_normalize",
+ abort("Can't open $unicode_normalize",
"Error opening file $unicode_normalize");
- return;
+ return;
}
my $pid;
unless ($pid = open2( \*Reader, \*Writer, "$normalize"))
{
- abort("Can't open pipes to $normalize", "Error opening pipes.");
- return;
+ abort("Can't open pipes to $normalize", "Error opening pipes.");
+ return;
}
-
+
my $diff = "";
my $nok = 0;
my $total = 0;
-
+
my @listed_norms;
while(<UCD>)
{
- my $orig = $_;
- $orig =~ s/# \(.*\) (.*)\n$/# $1/;
-
- s/\s*#.*$//;
-
- # Only one letter in first position!
- next unless (/^[A-F0-9]+;/);
-
- my @c = split /;/, $_, 6;
- $listed_norms{hex($c[0])} = 1;
+ my $orig = $_;
+ $orig =~ s/# \(.*\) (.*)\n$/# $1/;
+
+ s/\s*#.*$//;
+
+ # Only one letter in first position!
+ next unless (/^[A-F0-9]+;/);
+
+ my @c = split /;/, $_, 6;
+ $listed_norms{hex($c[0])} = 1;
}
-
+
for (my $i = 0; $i <= $MAX_TEST; $i++)
{
- next if exists $listed_norms{$i};
-
- printf Writer "n%X\n", $i;
- my @res = split /;/, <Reader>, 6;
- next if $res[0] eq "UNDEFINED CHARACTER\n";
- if ($res[0] ne $res[1] || $res[0] ne $res[2] ||
- $res[0] ne $res[3] || $res[0] ne $res[4])
- {
- $nok++;
- $diff .= " Expected: $i: $i;$i;$i;$i;$i\n";
- $diff .= " got : $i: $res[0];$res[1];$res[2];$res[3];$res[4]\n";
- }
+ next if exists $listed_norms{$i};
+
+ printf Writer "n%X\n", $i;
+ my @res = split /;/, <Reader>, 6;
+ next if $res[0] eq "UNDEFINED CHARACTER\n";
+ if ($res[0] ne $res[1] || $res[0] ne $res[2] ||
+ $res[0] ne $res[3] || $res[0] ne $res[4])
+ {
+ $nok++;
+ my $pos = sprintf("%8X", $i);
+ $diff .= " Expected: $pos: $pos;$pos;$pos;$pos;$pos\n";
+ $diff .= " got : $pos: $res[0];$res[1];$res[2];$res[3];$res[4]\n";
+ }
}
-
+
close *Reader;
close *Writer;
close UCD;
-
+
pass() unless ($diff);
fail("normalize output differs from the file downloaded.",
- "First difference:\n$diff\n not OK: $nok\n") if ($diff);
+ "First difference:\n$diff\n not OK: $nok\n") if ($diff);
}
@@ -690,12 +722,12 @@
{
my $run_this = shift;
foreach $valid (@registered_tests) {
- next if ($valid ne $run_this);
- $running_test = $run_this;
- &$running_test();
+ next if ($valid ne $run_this);
+ $running_test = $run_this;
+ &$running_test();
}
abort("Invalid testname given!", "$run_this is not a valid test.")
- unless ($running_test);
+ unless ($running_test);
$running_test = "";
}
@@ -712,11 +744,11 @@
{
if (not scalar(@ARGV))
{
- foreach my $test (@registered_tests) { run_test($test); }
+ foreach my $test (@registered_tests) { run_test($test); }
}
else
{
- while(my $param = shift @ARGV) { run_test($param); }
+ while(my $param = shift @ARGV) { run_test($param); }
}
}