← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/libunicode-map-perl/gutsy

« back to all changes in this revision

Viewing changes to t/map.t

  • Committer: Bazaar Package Importer
  • Author(s): Ardo van Rangelrooij
  • Date: 2001-12-23 12:34:26 UTC
  • Revision ID: james.westby@ubuntu.com-20011223123426-h5fya5zrevf43st3
Tags: upstream-0.110
Import upstream version 0.110

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/map.t
 
1
# Before `make install' is performed this script should be runnable with
 
2
# `make test'. After `make install' it should work as `perl test.pl'
 
3
 
 
4
######################### We start with some black magic to print on failure.
 
5
 
 
6
# Change 1..1 below to 1..last_test_to_print .
 
7
# (It may become useful if the test is moved to ./t subdirectory.)
 
8
 
 
9
BEGIN { $| = 1; print "1..4\n"; }
 
10
END {print "not ok 1\n" unless $loaded;}
 
11
use Unicode::Map;
 
12
$loaded = 1;
 
13
print "ok 1\n";
 
14
print STDERR "\n";
 
15
 
 
16
######################### End of black magic.
 
17
 
 
18
# Insert your test code below (better if it prints "ok 13"
 
19
# (correspondingly "not ok 13") depending on the success of chunk 13
 
20
# of the test code):
 
21
 
 
22
use strict;
 
23
 
 
24
my @test = ( 
 
25
   map { ref($_) ? $_ : [$_] }
 
26
   ["CP936",          "n->m: CP936"],
 
27
   ["GB2312",         "n->m: GB2312 (GB2312-80^8080 + ISO8859-1)"],
 
28
   ["DEVANAGA",       "n->m: DEVANAGA"],
 
29
);
 
30
 
 
31
{
 
32
   my $max = 0;
 
33
   my $len;
 
34
   for (0..$#test) { 
 
35
      $len = length($test[$_]->[$#{$test[$_]}]);
 
36
      $max = $len if $len>$max;
 
37
   }
 
38
      
 
39
   my ($name, $desc);
 
40
   my $i=2;
 
41
   for (sort {$test[$a]->[$#{$test[$a]}] cmp $test[$b]->[$#{$test[$b]}]} 
 
42
        0..$#test
 
43
   ) {
 
44
      ($name, $desc) = @{$test[$_]};
 
45
      $desc = $name if !defined $desc;
 
46
      _out($max, $i, $desc); 
 
47
      test ($i++, eval "&$name($_, \"$name\")");
 
48
   }
 
49
}
 
50
 
 
51
sub _out {
 
52
   my $max = shift;
 
53
   my $t = sprintf "    #%2d: %s ", @_;
 
54
   $t .= "." x (9 + 4 + $max - length($t));
 
55
   printf STDERR "$t ";
 
56
}
 
57
 
 
58
sub test {
 
59
   my ($number, $status) = @_;
 
60
   if ($status) {
 
61
      print STDERR "ok\n";
 
62
      print "ok $number\n";
 
63
   } else {
 
64
      print STDERR "failed!\n";
 
65
      print "not ok $number\n";
 
66
   }
 
67
}
 
68
 
 
69
sub CP936 {
 
70
   my $_locale =
 
71
      "\xd5\xe2\xca\xc7\xd2\xbb\xb8\xf6\xc0\xfd\xd7\xd3".
 
72
      "\xa3\xac\xc7\xeb\xb2\xe2\xca\xd4\xa1\xa3\x0d\x0d"
 
73
   ;
 
74
   my $_unicode = 
 
75
      "\x8f\xd9\x66\x2f\x4e\x00\x4e\x2a\x4f\x8b\x5b\x50".
 
76
      "\xff\x0c\x8b\xf7\x6d\x4b\x8b\xd5\x30\x02\x00\x0d".
 
77
      "\00\x0d"
 
78
   ;
 
79
   return testMapping ( "CP936", $_locale, $_unicode );
 
80
}
 
81
 
 
82
sub GB2312 {
 
83
   my $_locale  =
 
84
      "<title>".
 
85
      "\xc5\xb7\xbd\xf5\xc8\xfc"
 
86
      ."</title>"
 
87
   ;
 
88
   my $_unicode =
 
89
      "\00<\00t\00i\00t\00l\00e\00>".
 
90
      "\x6b\x27\x95\x26\x8d\x5b"
 
91
      ."\00<\00/\00t\00i\00t\00l\00e\00>"
 
92
   ;
 
93
   return testMapping ( "GB2312", $_locale, $_unicode );
 
94
}
 
95
 
 
96
 
 
97
sub DEVANAGA {
 
98
   my $_locale  =
 
99
      "\xa1\xe9"
 
100
      ." ABc"
 
101
      ."\xa1\xf8"
 
102
      ."\xe8\xe8\xe8\xe9"
 
103
      ."  "
 
104
   ;
 
105
   my $_unicode =
 
106
      "\x09\x50"
 
107
      ."\x00\x20\x00\x41\x00\x42\x00\x63"
 
108
      ."\x09\x01\x09\x6d"
 
109
      ."\x09\x4d\x20\x0c\x09\x4d\x20\x0d"
 
110
      ."\x00\x20\x00\x20"
 
111
   ;
 
112
   return testMapping ( "APPLE-DEVANAGA", $_locale, $_unicode );
 
113
}
 
114
 
 
115
sub testMapping {
 
116
    my ( $charsetId, $txtLocale, $txtUnicode ) = @_;
 
117
    return 0 if ! ( my $Map = new Unicode::Map($charsetId) );
 
118
    return 0 if $txtLocale ne $Map -> from_unicode ( $txtUnicode );
 
119
    return 0 if $txtUnicode ne $Map -> to_unicode ( $txtLocale );
 
120
    my $garbage = $Map -> from_unicode ( $txtLocale );
 
121
    return 0 if $garbage && $txtLocale eq $garbage;
 
122
1}
 
123