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