candidate for TR18 compliance

Date: Thu, 22 Apr 2004 14:31:30 -0400 (EDT)
Message-ID: <Pine.LNX.4.44.0404221429040.10466-101000@perlmonk.org>

Date: Mon, 26 Apr 2004 12:37:21 -0400 (EDT)
Message-ID: <Pine.LNX.4.44.0404261222320.7154-400000@perlmonk.org>

p4raw-id: //depot/perl@22744

1 files changed, 113 insertions, 1 deletions

diff --git a/t/uni/class.t b/t/uni/class.t
index 24f65fa2aa..72ba7e364c 100644
--- a/t/uni/class.t
+++ b/t/uni/class.t
@@ -4,7 +4,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan tests => 4;
+plan tests => 4334;
 
 sub MyUniClass {
   <<END;
@@ -30,6 +30,7 @@ my $str = join "", map chr($_), 0x20 .. 0x6F;
 
 # make sure it finds built-in class
 is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
+is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
 
 # make sure it finds user-defined class
 is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
@@ -39,3 +40,114 @@ is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
 
 # make sure it finds class in other OTHER package
 is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO');
+
+# all of these should look in lib/unicore/bc/AL.pl
+$str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}";
+is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{070E}\x{070F}");
+is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{070E}\x{070F}");
+is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{070E}\x{070F}");
+is(($str =~ /(\P{bc=AL}+)/)[0], "\x{070E}\x{070F}");
+
+# make sure InGreek works
+$str = "[\x{038B}\x{038C}\x{038D}]";
+
+is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
+is(($str =~ /(\p{Script:InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
+is(($str =~ /(\p{Script=InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
+is(($str =~ /(\p{sc:InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
+is(($str =~ /(\p{sc=InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
+
+
+use File::Spec;
+my $updir = File::Spec->updir;
+
+
+# the %utf8::... hashes are already in existence
+# because utf8_pva.pl was run by utf8_heavy.pl
+
+# non-General Category and non-Script
+while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) {
+  my $prop_name = $utf8::PropertyAlias{$abbrev};
+  next unless $prop_name;
+  next if $abbrev eq "gc_sc";
+
+  for (sort keys %$files) {
+    my $filename = File::Spec->catfile(
+      $updir => lib => unicore => lib => $abbrev => "$files->{$_}.pl"
+    );
+
+    next unless -e $filename;
+    my ($h1, $h2) = map hex, split /\t/, (do $filename);
+    my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+    for my $p ($prop_name, $abbrev) {
+      for my $c ($files->{$_}, $_) {
+        is($str =~ /(\p{$p: $c}+)/ && $1, substr($str, 0, -1));
+        is($str =~ /(\P{$p= $c}+)/ && $1, substr($str, -1));
+      }
+    }
+  }
+}
+
+# General Category and Script
+for my $p ('gc', 'sc') {
+  while (my ($abbr) = each %{ $utf8::PropValueAlias{$p} }) {
+    my $filename = File::Spec->catfile(
+      $updir => lib => unicore => lib => gc_sc => "$utf8::PVA_abbr_map{gc_sc}{$abbr}.pl"
+    );
+
+    next unless -e $filename;
+    my ($h1, $h2) = map hex, split /\t/, (do $filename);
+    my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+    for my $x ($p, { gc => 'General Category', sc => 'Script' }->{$p}) {
+      for my $y ($abbr, $utf8::PropValueAlias{$p}{$abbr}, $utf8::PVA_abbr_map{gc_sc}{$abbr}) {
+        is($str =~ /(\p{$x: $y}+)/ && $1, substr($str, 0, -1));
+        is($str =~ /(\P{$x= $y}+)/ && $1, substr($str, -1));
+        is($str =~ /(\p{$y}+)/ && $1, substr($str, 0, -1));
+        is($str =~ /(\P{$y}+)/ && $1, substr($str, -1));
+      }
+    }
+  }
+}
+
+# test extra properties (ASCII_Hex_Digit, Bidi_Control, etc.)
+for (keys %utf8::PA_reverse) {
+  my $filename = File::Spec->catfile(
+    $updir => lib => unicore => lib => gc_sc => "$utf8::PA_reverse{$_}.pl"
+  );
+
+  next unless -e $filename;
+  my ($h1, $h2) = map hex, split /\t/, (do $filename);
+  my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+  for my $x ('gc', 'General Category') {
+    for my $y ($_, $utf8::PA_reverse{$_}) {
+      is($str =~ /(\p{$x: $y}+)/ && $1, substr($str, 0, -1));
+      is($str =~ /(\P{$x= $y}+)/ && $1, substr($str, -1));
+      is($str =~ /(\p{$y}+)/ && $1, substr($str, 0, -1));
+      is($str =~ /(\P{$y}+)/ && $1, substr($str, -1));
+    }
+  }
+}
+
+# test the blocks (InFoobar)
+for (grep $utf8::Canonical{$_} =~ /^In/, keys %utf8::Canonical) {
+  my $filename = File::Spec->catfile(
+    $updir => lib => unicore => lib => gc_sc => "$utf8::Canonical{$_}.pl"
+  );
+
+  next unless -e $filename;
+  my ($h1, $h2) = map hex, split /\t/, (do $filename);
+  my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+  my $blk = $_;
+
+  is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1));
+  is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1));
+
+  $blk =~ s/^In/Block:/;
+
+  is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1));
+  is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1));
+}