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