1## 2## Some functionality of Unicode-Map-0.105 is deprecated now. It is either 3## removed from the documentation or explicitly marked deprecated there. 4## 5## Anyway old code applying Unicode::Map should remain intact. This test 6## asserts that: 7## 1. The deprecated usage is still available 8## 2. Unicode::Map issues warnings if $WARNINGS & WARN_DEPRECATION 9## 10 11# Before `make install' is performed this script should be runnable with 12# `make test'. After `make install' it should work as `perl test.pl' 13 14######################### We start with some black magic to print on failure. 15 16# Change 1..1 below to 1..last_test_to_print . 17# (It may become useful if the test is moved to ./t subdirectory.) 18 19BEGIN { $| = 1; print "1..5\n"; } 20END {print "not ok 1\n" unless $loaded;} 21use Unicode::Map; 22$loaded = 1; 23print "ok 1\n"; 24print STDERR "\n"; 25 26######################### End of black magic. 27 28# Insert your test code below (better if it prints "ok 13" 29# (correspondingly "not ok 13") depending on the success of chunk 13 30# of the test code): 31 32use strict; 33 34my $locale = "K�se"; 35my $utf16 = "\0K\0�\0s\0e"; 36my $warnings = 0; 37 38my @test = ( 39 map { ref($_) ? $_ : [$_] } 40 ["new_no_id", "new: joker charset id"], 41 ["new_id_select", "new: preselected charset id"], 42 ["reverse", "reverse unicode"], 43 ["noise", "noise"], 44); 45 46{ 47 my $max = 0; 48 my $len; 49 for (0..$#test) { 50 $len = length($test[$_]->[$#{$test[$_]}]); 51 $max = $len if $len>$max; 52 } 53 54 my ($name, $desc); 55 my $i=2; 56 for (sort {$test[$a]->[$#{$test[$a]}] cmp $test[$b]->[$#{$test[$b]}]} 57 0..$#test 58 ) { 59 ($name, $desc) = @{$test[$_]}; 60 $desc = $name if !defined $desc; 61 _out($max, $i, $desc); 62 test ($i++, eval "&$name($_, \"$name\")"); 63 } 64} 65 66sub _out { 67 my $max = shift; 68 my $t = sprintf " #%2d: %s ", @_; 69 $t .= "." x (9 + 4 + $max - length($t)); 70 printf STDERR "$t "; 71} 72 73sub test { 74 my ($number, $status) = @_; 75 if ($status) { 76 print STDERR "ok\n"; 77 print "ok $number\n"; 78 } else { 79 print STDERR "failed!\n"; 80 print "not ok $number\n"; 81 } 82} 83 84## 85## Tests if a construction like this is supported: 86## 87## my $Map = new Unicode::Map ( ); 88## my $utf16 = $Map -> to_unicode ( "ISO-8859-1", $str ); 89## 90## Correct usage would be: 91## 92## my $Map = new Unicode::Map ( "ISO-8859-1" ); 93## my $utf16 = $Map -> to_unicode ( $str ); 94## 95sub new_no_id { 96 setWarnings ( ); 97 return 0 unless $warnings == 0; 98 my $Map = new Unicode::Map ( ); 99 return 0 unless $warnings == 1; 100 return 0 unless $Map; 101 return 0 unless $Map -> to_unicode ( "ISO-8859-1", $locale ) eq $utf16; 102 return 0 unless $warnings == 2; 103 return 0 unless $Map -> from_unicode ( "ISO-8859-1", $utf16 ) eq $locale; 104 return 0 unless $warnings == 3; 105 setNoWarnings ( ); 1061} 107 108## 109## Tests if a constructor with this form is supported: 110## 111## new Unicode::Map ( {ID => "ISO-8859-1"} ); 112## 113## Correct usage would be: 114## 115## new Unicode::Map ( "ISO-8859-1" ); 116## 117sub new_id_select { 118 setWarnings ( ); 119 return 0 unless $warnings == 0; 120 return 0 unless my $Map = new Unicode::Map ({ ID => "ISO-8859-1" }); 121 return 0 unless $warnings == 1; 122 return 0 unless $Map -> to_unicode ( $locale ) eq $utf16; 123 return 0 unless $Map -> from_unicode ( $utf16 ) eq $locale; 124 return 0 unless $warnings == 1; 125 setNoWarnings ( ); 1261} 127 128## 129## Tests if this method is supported: 130## 131## $utf16 = "\0S\0o\0m\0e"; 132## $Map -> reverse_unicode ( $utf16 ); 133## 134## Proposed substitute for this deprecated usage: 135## 136## Unicode::String::byteswap ( $utf16 ); 137## 138sub reverse { 139 my $utf16 = "K\0�\0s\0e\0"; 140 setWarnings ( ); 141 return 0 unless my $Map = new Unicode::Map ( "ISO-8859-1" ); 142 return 0 unless $warnings == 0; 143 $Map -> reverse_unicode ( $utf16 ); 144 return 0 unless $warnings == 1; 145 146 # Has the original variable been changed? 147 return 0 unless $utf16 eq "\0K\0�\0s\0e"; 148 149 # Did we get a transfored copy? 150 return 0 unless $Map -> reverse_unicode ( $utf16 ) eq "K\0�\0s\0e\0"; 151 return 0 unless $warnings == 2; 152 153 # Was it really a copy? 154 return 0 unless $utf16 eq "\0K\0�\0s\0e"; 155 156 setNoWarnings ( ); 1571} 158 159## 160## Tests if method "noise" is available: 161## 162sub noise { 163 setWarnings ( ); 164 return 0 unless my $Map = new Unicode::Map ( "ISO-8859-1" ); 165 return 0 unless $warnings == 0; 166 $Map -> noise ( 3 ); 167 return 0 unless $warnings == 1; 168 setNoWarnings ( ); 169} 170 171 172# 173# utilities 174# 175 176sub setWarnings { 177 $warnings = 0; 178 $SIG{'__WARN__'} = sub { 179 $warnings++; 180 }; 181 $Unicode::Map::WARNINGS = Unicode::Map::WARN_DEPRECATION; 1821} 183 184sub setNoWarnings { 185 $SIG{'__WARN__'} = 0; 186 $warnings = 0; 187 $Unicode::Map::WARNINGS = Unicode::Map::WARN_DEFAULT; 1881} 189 190