lib/h2xs.t (was Re: [PATCH] h2xs)

[perl5.git] / lib / utf8_heavy.pl

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index d9454b0..b73cea0 100644 (file)
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -26,19 +26,32 @@ sub SWASHNEW {
     while (($caller = caller($i)) eq __PACKAGE__) { $i++ }
     my $encoding = $enc{$caller} || "unicode";
     (my $file = $type) =~ s!::!/!g;
-    $file =~ s#^(I[sn]|To)([A-Z].*)#$1/$2#;
-    $list ||= eval { $caller->$type(); }
-       || do "$file.pl"
-       || do "unicode/$file.pl"
-       || do "unicode/Is/${type}.pl"
-       || croak("Can't find character property definition via $caller->$type or $file.pl");
+    if ($file =~ /^In(.+)/) {
+       my $In = $1;
+       defined %utf8::In || do "$encoding/In.pl";
+       if (exists $utf8::In{$In}) {
+           $file = "$encoding/In/$utf8::In{$In}";
+       }
+    } else {
+       $file =~ s#^(Is|To)([A-Z].*)#$1/$2#;
+    }
+
+    {
+        $list ||=
+           ( exists &{"${caller}::${type}"} &&
+             eval { $caller->$type() } )
+           || do "$file.pl"
+           || do "$encoding/$file.pl"
+           || do "$encoding/Is/${type}.pl"
+           || croak("Can't find $encoding character property \"$type\"");
+    }
 
     $| = 1;
 
     if ($list) {
        my @tmp = split(/^/m, $list);
        my %seen;
-       local $^W = 0;
+       no warnings;
        $extras = join '', grep /^[^0-9a-fA-F]/, @tmp;
        $list = join '',
            sort { hex $a <=> hex $b }
@@ -69,7 +82,7 @@ sub SWASHNEW {
     my @extras;
     for my $x ($extras) {
        pos $x = 0;
-       while ($x =~ /^([^0-9a-fA-F])(.*)/mg) {
+       while ($x =~ /^([^0-9a-fA-F\n])(.*)/mg) {
            my $char = $1;
            my $name = $2;
            # print STDERR "$1 => $2\n" if $DEBUG;
@@ -99,10 +112,10 @@ sub SWASHNEW {
 sub SWASHGET {
     my ($self, $start, $len) = @_;
     local $^D = 0 if $^D;
-    print STDERR "SWASHGET @_\n" if $DEBUG;
     my $type = $self->{TYPE};
     my $bits = $self->{BITS};
     my $none = $self->{NONE};
+    print STDERR "SWASHGET @_ [$type/$bits/$none]\n" if $DEBUG;
     my $end = $start + $len;
     my $swatch = "";
     my $key;
@@ -123,8 +136,7 @@ sub SWASHGET {
 #              print "$min $max $val\n";
                if ($none) {
                    if ($min < $start) {
-                       $val += $start - $min;
-                       $val = $none if $val > $none;
+                       $val += $start - $min if $val < $none;
                        $min = $start;
                    }
                    for ($key = $min; $key <= $max; $key++) {
@@ -166,45 +178,43 @@ sub SWASHGET {
     }
     for my $x ($self->{EXTRAS}) {
        pos $x = 0;
-       while ($x =~ /^([^0-9a-fA-F])(.*)/mg) {
+       while ($x =~ /^([-+!])(.*)/mg) {
            my $char = $1;
            my $name = $2;
            print STDERR "INDIRECT $1 $2\n" if $DEBUG;
-           if ($char =~ /^[-+!]$/) {
-               my $otherbits = $self->{$name}->{BITS};
-               croak("SWASHGET size mismatch") if $bits < $otherbits;
-               my $other = $self->{$name}->SWASHGET($start, $len);
-               if ($char eq '+') {
-                   if ($bits == 1 and $otherbits == 1) {
-                       $swatch |= $other;
-                   }
-                   else {
-                       for ($key = 0; $key < $len; $key++) {
-                           vec($swatch, $key, $bits) = vec($other, $key, $otherbits);
-                       }
-                   }
+           my $otherbits = $self->{$name}->{BITS};
+           croak("SWASHGET size mismatch") if $bits < $otherbits;
+           my $other = $self->{$name}->SWASHGET($start, $len);
+           if ($char eq '+') {
+               if ($bits == 1 and $otherbits == 1) {
+                   $swatch |= $other;
                }
-               elsif ($char eq '!') {
-                   if ($bits == 1 and $otherbits == 1) {
-                       $swatch |= ~$other;
+               else {
+                   for ($key = 0; $key < $len; $key++) {
+                       vec($swatch, $key, $bits) = vec($other, $key, $otherbits);
                    }
-                   else {
-                       for ($key = 0; $key < $len; $key++) {
-                           if (!vec($other, $key, $otherbits)) {
-                               vec($swatch, $key, $bits) = 1;
-                           }
+               }
+           }
+           elsif ($char eq '!') {
+               if ($bits == 1 and $otherbits == 1) {
+                   $swatch |= ~$other;
+               }
+               else {
+                   for ($key = 0; $key < $len; $key++) {
+                       if (!vec($other, $key, $otherbits)) {
+                           vec($swatch, $key, $bits) = 1;
                        }
                    }
                }
-               elsif ($char eq '-') {
-                   if ($bits == 1 and $otherbits == 1) {
-                       $swatch &= ~$other;
-                   }
-                   else {
-                       for ($key = 0; $key < $len; $key++) {
-                           if (vec($other, $key, $otherbits)) {
-                               vec($swatch, $key, $bits) = 0;
-                           }
+           }
+           elsif ($char eq '-') {
+               if ($bits == 1 and $otherbits == 1) {
+                   $swatch &= ~$other;
+               }
+               else {
+                   for ($key = 0; $key < $len; $key++) {
+                       if (vec($other, $key, $otherbits)) {
+                           vec($swatch, $key, $bits) = 0;
                        }
                    }
                }