xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/ext/Encode/t/fallback.t (revision 0:68f95e015346) 
1BEGIN {
2    if ($ENV{'PERL_CORE'}){
3        chdir 't';
4        unshift @INC, '../lib';
5    }
6    require Config; import Config;
7    if ($Config{'extensions'} !~ /\bEncode\b/) {
8      print "1..0 # Skip: Encode was not built\n";
9      exit 0;
10    }
11    if (ord("A") == 193) {
12	print "1..0 # Skip: EBCDIC\n";
13	exit 0;
14    }
15    $| = 1;
16}
17
18use strict;
19#use Test::More qw(no_plan);
20use Test::More tests => 22;
21use Encode q(:all);
22
23my $original = '';
24my $nofallback  = '';
25my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref);
26for my $i (0x20..0x7e){
27    $original .= chr($i);
28}
29$fallenback = $quiet =
30$perlqq = $htmlcref = $xmlcref = $nofallback = $original;
31
32my $residue = '';
33for my $i (0x80..0xff){
34    $original   .= chr($i);
35    $residue    .= chr($i);
36    $fallenback .= '?';
37    $perlqq     .= sprintf("\\x{%04x}", $i);
38    $htmlcref    .= sprintf("&#%d;", $i);
39    $xmlcref    .= sprintf("&#x%x;", $i);
40}
41utf8::upgrade($original);
42my $meth   = find_encoding('ascii');
43
44my $src = $original;
45my $dst = $meth->encode($src, FB_DEFAULT);
46is($dst, $fallenback, "FB_DEFAULT");
47is($src, $original,   "FB_DEFAULT residue");
48
49$src = $original;
50eval{ $dst = $meth->encode($src, FB_CROAK) };
51like($@, qr/does not map to ascii/o, "FB_CROAK");
52is($src, $original, "FB_CROAK residue");
53
54$src = $original;
55eval{ $dst = $meth->encode($src, FB_CROAK) };
56like($@, qr/does not map to ascii/o, "FB_CROAK");
57is($src, $original, "FB_CROAK residue");
58
59
60$src = $nofallback;
61eval{ $dst = $meth->encode($src, FB_CROAK) };
62is($@, '', "FB_CROAK on success");
63is($src, '', "FB_CROAK on success residue");
64
65$src = $original;
66$dst = $meth->encode($src, FB_QUIET);
67is($dst, $quiet,   "FB_QUIET");
68is($src, $residue, "FB_QUIET residue");
69
70{
71    my $message;
72    local $SIG{__WARN__} = sub { $message = $_[0] };
73    $src = $original;
74    $dst = $meth->encode($src, FB_WARN);
75    is($dst, $quiet,   "FB_WARN");
76    is($src, $residue, "FB_WARN residue");
77    like($message, qr/does not map to ascii/o, "FB_WARN message");
78
79    $message = '';
80
81    $src = $original;
82    $dst = $meth->encode($src, WARN_ON_ERR);
83
84    is($dst, $fallenback, "WARN_ON_ERR");
85    is($src, '',  "WARN_ON_ERR residue");
86    like($message, qr/does not map to ascii/o, "WARN_ON_ERR message");
87}
88
89$src = $original;
90$dst = $meth->encode($src, FB_PERLQQ);
91is($dst, $perlqq,   "FB_PERLQQ");
92is($src, '', "FB_PERLQQ residue");
93
94$src = $original;
95$dst = $meth->encode($src, FB_HTMLCREF);
96is($dst, $htmlcref,   "FB_HTMLCREF");
97is($src, '', "FB_HTMLCREF residue");
98
99$src = $original;
100$dst = $meth->encode($src, FB_XMLCREF);
101is($dst, $xmlcref,   "FB_XMLCREF");
102is($src, '', "FB_XMLCREF residue");
103