Home | History | Annotate | Download | only in tests 
      1 #! /usr/bin/perl -w
      2 
      3 #    Copyright (C) 1998, 1999 Tom Tromey
      4 #    Copyright (C) 2001 Red Hat Software
      5 
      6 #    This program is free software; you can redistribute it and/or modify
      7 #    it under the terms of the GNU General Public License as published by
      8 #    the Free Software Foundation; either version 2, or (at your option)
      9 #    any later version.
     10 
     11 #    This program is distributed in the hope that it will be useful,
     12 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
     13 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14 #    GNU General Public License for more details.
     15 
     16 #    You should have received a copy of the GNU General Public License
     17 #    along with this program; if not, write to the Free Software
     18 #    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     19 #    02111-1307, USA.
     20 
     21 # gen-casefold-test.pl - Generate test cases for casefolding from Unicode data.
     22 # See http://www.unicode.org/Public/UNIDATA/UnicodeCharacterDatabase.html
     23 # Usage: 
     24 # I consider the output of this program to be unrestricted.  Use it as
     25 # you will.
     26 
     27 require 5.006;
     28 
     29 # Names of fields in the CaseFolding table
     30 $FOLDING_CODE = 0;
     31 $FOLDING_STATUS = 1;
     32 $FOLDING_MAPPING = 2;
     33 
     34 my $casefoldlen = 0;
     35 my @casefold;
     36 
     37 if (@ARGV != 2) {
     38     $0 =~ s@.*/@@;
     39     die "Usage: $0 UNICODE-VERSION  CaseFolding.txt\n";
     40 }
     41  
     42 print <<EOT;
     43 # Test cases generated from Unicode $ARGV[0] data
     44 # by gen-casefold-test.pl. Do not edit.
     45 #
     46 # Some special hand crafted tests
     47 #
     48 AaBbCc@@\taabbcc@@
     49 #
     50 # Now the automatic tests
     51 #
     52 EOT
     53 
     54 binmode STDOUT, ":utf8";
     55 open (INPUT, "< $ARGV[1]") || exit 1;
     56 
     57 while (<INPUT>)
     58 {
     59     chop;
     60 
     61     next if /^#/;
     62     next if /^\s*$/;
     63 
     64     s/\s*#.*//;
     65 
     66     my @fields = split ('\s*;\s*', $_, 30);
     67 
     68     my $raw_code = $fields[$FOLDING_CODE];
     69     my $code = hex ($raw_code);
     70 
     71     if ($#fields != 3)
     72     {
     73 	printf STDERR ("Entry for $raw_code has wrong number of fields (%d)\n", $#fields);
     74 	next;
     75     }
     76 
     77     # skip simple and Turkic mappings
     78     next if ($fields[$FOLDING_STATUS] =~ /^[ST]$/);
     79 
     80     @values = map { hex ($_) } split /\s+/, $fields[$FOLDING_MAPPING];
     81     printf ("%s\t%s\n", pack ("U", $code), pack ("U*", @values));
     82 }
     83 
     84 close INPUT;
     85