$foo .= $bar doesn't warn if $foo is undefined, so simplify code.

[p5sagit/p5-mst-13.2.git] / t / uni / class.t

diff --git a/t/uni/class.t b/t/uni/class.t
index deb2982..fa4cbf5 100644 (file)
--- a/t/uni/class.t
+++ b/t/uni/class.t
@@ -25,6 +25,30 @@ sub A::B::Intersection {
 END
 }
 
+sub test_regexp ($$) {
+  # test that given string consists of N-1 chars matching $qr1, and 1
+  # char matching $qr2
+  my ($str, $blk) = @_;
+
+  # constructing these objects here makes the last test loop go much faster
+  my $qr1 = qr/(\p{$blk}+)/;
+  if ($str =~ $qr1) {
+    is($1, substr($str, 0, -1));               # all except last char
+  }
+  else {
+    fail('first N-1 chars did not match');
+  }
+
+  my $qr2 = qr/(\P{$blk}+)/;
+  if ($str =~ $qr2) {
+    is($1, substr($str, -1));                  # only last char
+  }
+  else {
+    fail('last char did not match');
+  }
+}
+
+use strict;
 
 my $str = join "", map chr($_), 0x20 .. 0x6F;
 
@@ -57,14 +81,16 @@ 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
 
+*utf8::PropertyAlias = *utf8::PropertyAlias; # thwart a warning
+
+no warnings 'utf8'; # we do not want warnings about surrogates etc
+
 # non-General Category and non-Script
 while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) {
   my $prop_name = $utf8::PropertyAlias{$abbrev};
@@ -77,7 +103,7 @@ while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) {
     );
 
     next unless -e $filename;
-    my ($h1, $h2) = map hex, split /\t/, (do $filename);
+    my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
     my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
 
     for my $p ($prop_name, $abbrev) {
@@ -97,15 +123,14 @@ for my $p ('gc', 'sc') {
     );
 
     next unless -e $filename;
-    my ($h1, $h2) = map hex, split /\t/, (do $filename);
+    my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
     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_regexp ($str, $y);
       }
     }
   }
@@ -125,9 +150,9 @@ SKIP:
 
   my %files;
 
-  my $dirname = File::Spec->catdir($updir => lib => unicore => lib => gc_sc);
+  my $dirname = File::Spec->catdir($updir => lib => unicore => lib => 'gc_sc');
   opendir D, $dirname or die $!;
-  @files{readdir D} = ();
+  @files{readdir(D)} = ();
   closedir D;
 
   for (keys %utf8::PA_reverse) {
@@ -136,7 +161,7 @@ SKIP:
 
     my $filename = File::Spec->catfile($dirname, $leafname);
 
-    my ($h1, $h2) = map hex, split /\t/, (do $filename);
+    my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
     my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
 
     for my $x ('gc', 'General Category') {
@@ -144,8 +169,7 @@ SKIP:
       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_regexp ($str, $y);
       }
     }
   }
@@ -158,16 +182,16 @@ for (grep $utf8::Canonical{$_} =~ /^In/, keys %utf8::Canonical) {
   );
 
   next unless -e $filename;
-  my ($h1, $h2) = map hex, split /\t/, (do $filename);
+
+  print "# In$_ $filename\n";
+
+  my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
   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));
-
+  test_regexp ($str, $blk);
   $blk =~ s/^In/Block:/;
-
-  is($str =~ /(\p{$blk}+)/ && $1, substr($str, 0, -1));
-  is($str =~ /(\P{$blk}+)/ && $1, substr($str, -1));
+  test_regexp ($str, $blk);
 }
+