1 files changed, 77 insertions, 0 deletions
diff --git a/ext/Encode/t/fallback.t b/ext/Encode/t/fallback.t
new file mode 100644
index 0000000000..cf867beb01
--- /dev/null
+++ b/ext/Encode/t/fallback.t
@@ -0,0 +1,77 @@
+BEGIN {
+    if ($ENV{'PERL_CORE'}){
+        chdir 't';
+        unshift @INC, '../lib';
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bEncode\b/) {
+      print "1..0 # Skip: Encode was not built\n";
+      exit 0;
+    }
+    $| = 1;
+}
+
+use strict;
+#use Test::More qw(no_plan);
+use Test::More tests => 15;
+use Encode q(:all);
+
+
+my $original = '';
+my $nofallback  = '';
+my ($fallenback, $quiet, $perlqq);
+for my $i (0x20..0x7e){
+    $original .= chr($i);
+}
+$fallenback = $quiet = $perlqq = $nofallback = $original;
+
+my $residue = '';
+for my $i (0x80..0xff){
+    $original   .= chr($i);
+    $residue    .= chr($i);
+    $fallenback .= '?';
+    $perlqq     .= sprintf("\\x{%04x}", $i);
+}
+utf8::upgrade($original);
+my $meth   = find_encoding('ascii');
+
+my $src = $original;
+my $dst = $meth->encode($src, FB_DEFAULT);
+is($dst, $fallenback, "FB_DEFAULT");
+is($src, $original,   "FB_DEFAULT residue");
+
+$src = $original;
+eval{ $dst = $meth->encode($src, FB_CROAK) };
+like($@, qr/does not map to ascii/o, "FB_CROAK");
+is($src, $original, "FB_CROAK residue");
+
+$src = $original;
+eval{ $dst = $meth->encode($src, FB_CROAK) };
+like($@, qr/does not map to ascii/o, "FB_CROAK");
+is($src, $original, "FB_CROAK residue");
+
+
+$src = $nofallback;
+eval{ $dst = $meth->encode($src, FB_CROAK) };
+is($@, '', "FB_CROAK on success");
+is($src, '', "FB_CROAK on success residue");
+
+$src = $original;
+$dst = $meth->encode($src, FB_QUIET);
+is($dst, $quiet,   "FB_QUIET");
+is($src, $residue, "FB_QUIET residue");
+
+{
+    my $message;
+    local $SIG{__WARN__} = sub { $message = $_[0] };
+    $src = $original;
+    $dst = $meth->encode($src, FB_WARN);
+    is($dst, $quiet,   "FB_WARN");
+    is($src, $residue, "FB_WARN residue");
+    like($message, qr/does not map to ascii/o, "FB_WARN message");
+}
+
+$src = $original;
+$dst = $meth->encode($src, FB_PERLQQ);
+is($dst, $perlqq,   "FB_PERLQQ");
+is($src, '', "FB_PERLQQ residue");