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 9BEGIN { $| = 1; print "1..5\n"; } 10END {print "not ok 1\n" unless $loaded;} 11use Unicode::Map; 12$loaded = 1; 13print "ok 1\n"; 14print 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 22use strict; 23 24my @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 ["EUC_JP", "n->m: EUC-JP"], 30); 31 32{ 33 my $max = 0; 34 my $len; 35 for (0..$#test) { 36 $len = length($test[$_]->[$#{$test[$_]}]); 37 $max = $len if $len>$max; 38 } 39 40 my ($name, $desc); 41 my $i=2; 42 for (sort {$test[$a]->[$#{$test[$a]}] cmp $test[$b]->[$#{$test[$b]}]} 43 0..$#test 44 ) { 45 ($name, $desc) = @{$test[$_]}; 46 $desc = $name if !defined $desc; 47 _out($max, $i, $desc); 48 test ($i++, eval "&$name($_, \"$name\")"); 49 } 50} 51 52sub _out { 53 my $max = shift; 54 my $t = sprintf " #%2d: %s ", @_; 55 $t .= "." x (9 + 4 + $max - length($t)); 56 printf STDERR "$t "; 57} 58 59sub test { 60 my ($number, $status) = @_; 61 if ($status) { 62 print STDERR "ok\n"; 63 print "ok $number\n"; 64 } else { 65 print STDERR "failed!\n"; 66 print "not ok $number\n"; 67 } 68} 69 70sub CP936 { 71 my $_locale = 72 "\xd5\xe2\xca\xc7\xd2\xbb\xb8\xf6\xc0\xfd\xd7\xd3". 73 "\xa3\xac\xc7\xeb\xb2\xe2\xca\xd4\xa1\xa3\x0d\x0d" 74 ; 75 my $_unicode = 76 "\x8f\xd9\x66\x2f\x4e\x00\x4e\x2a\x4f\x8b\x5b\x50". 77 "\xff\x0c\x8b\xf7\x6d\x4b\x8b\xd5\x30\x02\x00\x0d". 78 "\00\x0d" 79 ; 80 return testMapping ( "CP936", $_locale, $_unicode ); 81} 82 83sub EUC_JP { 84 my $_locale = 85 "Copyright: \x8f\xa2\xed" . # Copyright 86 "\x5c" . # Yen sign 87 "\xa1\xa7" . # fullwidth : 88 "\xba\xcf" . # CJK 89 "\x8f\xed\xe3" # CJK 90 ; 91 my $_unicode = 92 "\00C\00o\00p\00y\00r\00i\00g\00h\00t\00:\00 \x00\xa9" . # Copyright 93 "\x00\xa5" . # Yen sign 94 "\xff\x1a" . # fullwidth : 95 "\x68\x3d" . # CJK 96 "\x9f\xa5" # CJK 97 ; 98 return testMapping ( "EUC-JP", $_locale, $_unicode ); 99} 100 101 102 103sub GB2312 { 104 my $_locale = 105 "<title>". 106 "\xc5\xb7\xbd\xf5\xc8\xfc" 107 ."</title>" 108 ; 109 my $_unicode = 110 "\00<\00t\00i\00t\00l\00e\00>". 111 "\x6b\x27\x95\x26\x8d\x5b" 112 ."\00<\00/\00t\00i\00t\00l\00e\00>" 113 ; 114 return testMapping ( "GB2312", $_locale, $_unicode ); 115} 116 117 118sub DEVANAGA { 119 my $_locale = 120 "\xa1\xe9" 121 ." ABc" 122 ."\xa1\xf8" 123 ."\xe8\xe8\xe8\xe9" 124 ." " 125 ; 126 my $_unicode = 127 "\x09\x50" 128 ."\x00\x20\x00\x41\x00\x42\x00\x63" 129 ."\x09\x01\x09\x6d" 130 ."\x09\x4d\x20\x0c\x09\x4d\x20\x0d" 131 ."\x00\x20\x00\x20" 132 ; 133 return testMapping ( "APPLE-DEVANAGA", $_locale, $_unicode ); 134} 135 136sub testMapping { 137 my ( $charsetId, $txtLocale, $txtUnicode ) = @_; 138 return 0 if ! ( my $Map = new Unicode::Map($charsetId) ); 139 return 0 if $txtLocale ne $Map -> from_unicode ( $txtUnicode ); 140 return 0 if $txtUnicode ne $Map -> to_unicode ( $txtLocale ); 141 my $garbage = $Map -> from_unicode ( $txtLocale ); 142 return 0 if $garbage && $txtLocale eq $garbage; 1431} 144 145