view release on metacpan or  search on metacpan

unicore/mktables  view on Meta::CPAN

    close IN;

    $Fold->Write("To/Fold.pl");

    #
    # Prepend the special foldings to the common foldings.
    #
    my $CommonFold = do "To/Fold.pl" || die "$0: To/Fold.pl: $!\n";

    my @OUT = (
               $HEADER, "\n",
               "%utf8::ToSpecFold =\n(\n",
              );
    for my $code (sort { $a <=> $b } keys %Fold) {
        my $foldstr =
          join "", map { sprintf "\\x{%s}", $_ } split ' ', $Fold{$code};
        push @OUT, sprintf qq['%04X' => "$foldstr",\n], $code;
    }
    push @OUT, (
                ");\n\n",
                "return <<'END';\n",
                $CommonFold,
                "END\n",
               );

    WriteIfChanged("To/Fold.pl", @OUT);
}

## Do it....

UnicodeData_Txt();
Make_GC_Aliases();
PropList_txt();

Scripts_txt();
Blocks_txt();

WriteAllMappings();

LineBreak_Txt();
ArabicShaping_txt();
Jamo_txt();
SpecialCasing_txt();
CaseFolding_txt();

exit(0);

## TRAILING CODE IS USED BY MakePropTestScript()
__DATA__
use strict;
use warnings;

my $Tests = 0;
my $Fails = 0;

sub Expect($$$)
{
    my $Expect = shift;
    my $String = shift;
    my $Regex  = shift;
    my $Line   = (caller)[2];

    $Tests++;
    my $RegObj;
    my $result = eval {
        $RegObj = qr/$Regex/;
        $String =~ $RegObj ? 1 : 0
    };
    
    if (not defined $result) {
        print "couldn't compile /$Regex/ on $0 line $Line: $@\n";
        $Fails++;
    } elsif ($result ^ $Expect) {
        print "bad result (expected $Expect) on $0 line $Line: $@\n";
        $Fails++;
    }
}

sub Error($)
{
    my $Regex  = shift;
    $Tests++;
    if (eval { 'x' =~ qr/$Regex/; 1 }) {
        $Fails++;
        my $Line = (caller)[2];
        print "expected error for /$Regex/ on $0 line $Line: $@\n";
    }
}

sub Finished()
{
   if ($Fails == 0) {
      print "All $Tests tests passed.\n";
      exit(0);
   } else {
      print "$Tests tests, $Fails failed!\n";
      exit(-1);
   }
}