Fix 'use encoding' I/O for code points 0x80..0xFF;

code changes from Inaba Hiroto; test tweaks by jhi.

p4raw-id: //depot/perl@18496

3 files changed, 73 insertions, 5 deletions

diff --git a/ext/Encode/encoding.pm b/ext/Encode/encoding.pm
index e8aa7374d5..1a43790b5c 100644
--- a/ext/Encode/encoding.pm
+++ b/ext/Encode/encoding.pm
@@ -29,8 +29,7 @@ sub import {
 	Carp::croak("Unknown encoding '$name'");
     }
     unless ($arg{Filter}) {
-	${^ENCODING} = $enc # this is all you need, actually.
-	    unless $name =~ /^(?:utf-?(?:8|16|32)|ucs-?(?:2|4))(?:[bl]e)?$/i;
+	${^ENCODING} = $enc;
 	$HAS_PERLIO or return 1;
 	for my $h (qw(STDIN STDOUT)){
 	    if ($arg{$h}){
diff --git a/ext/Encode/t/enc_eucjp.t b/ext/Encode/t/enc_eucjp.t
new file mode 100644
index 0000000000..019b42606f
--- /dev/null
+++ b/ext/Encode/t/enc_eucjp.t
@@ -0,0 +1,66 @@
+# This is the twin of enc_utf8.t, the only difference is that
+# this has "use encoding 'euc-jp'".
+
+BEGIN {
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bEncode\b/) {
+      print "1..0 # Skip: Encode was not built\n";
+      exit 0;
+    }
+    unless (find PerlIO::Layer 'perlio') {
+	print "1..0 # Skip: PerlIO was not built\n";
+	exit 0;
+    }
+    if (ord("A") == 193) {
+	print "1..0 # encoding pragma does not support EBCDIC platforms\n";
+	exit(0);
+    }
+}
+
+use encoding 'euc-jp';
+
+my @c = (127, 128, 255, 256);
+
+print "1.." . (scalar @c + 1) . "\n";
+
+my @f;
+
+for my $i (0..$#c) {
+  push @f, "f$i";
+  open(F, ">f$i") or die "$0: failed to open 'f$i' for writing: $!";
+  binmode(F, ":utf8");
+  print F chr($c[$i]);
+  close F;
+}
+
+my $t = 1;
+
+for my $i (0..$#c) {
+  open(F, "<f$i") or die "$0: failed to open 'f$i' for reading: $!";
+  binmode(F, ":utf8");
+  my $c = <F>;
+  my $o = ord($c);
+  print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n";
+  $t++;
+}
+
+my $f = "f" . @f;
+
+push @f, $f;
+open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
+binmode(F, ":raw"); # Output raw bytes.
+print F chr(128); # Output illegal UTF-8.
+close F;
+open(F, $f) or die "$0: failed to open '$f' for reading: $!";
+binmode(F, ":encoding(utf-8)");
+{
+	local $^W = 1;
+	local $SIG{__WARN__} = sub { $a = shift };
+	eval { <F> }; # This should get caught.
+}
+print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
+  "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
+
+END {
+  1 while unlink @f;
+}
diff --git a/ext/Encode/t/enc_utf8.t b/ext/Encode/t/enc_utf8.t
index 20eb288400..6271fe607f 100644
--- a/ext/Encode/t/enc_utf8.t
+++ b/ext/Encode/t/enc_utf8.t
@@ -1,3 +1,6 @@
+# This is the twin of enc_eucjp.t, the only difference is that
+# this has "use encoding 'utf8'".
+
 BEGIN {
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bEncode\b/) {
@@ -37,11 +40,11 @@ for my $i (0..$#c) {
   binmode(F, ":utf8");
   my $c = <F>;
   my $o = ord($c);
-  print $o == $c[$i] ? "ok $t\n" : "not ok $t # $o != $c[$i]\n";
+  print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$$i]: $o != $c[$i]\n";
   $t++;
 }
 
-my $f = "f4";
+my $f = "f" . @f;
 
 push @f, $f;
 open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
@@ -56,7 +59,7 @@ binmode(F, ":encoding(utf-8)");
 	eval { <F> }; # This should get caught.
 }
 print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
-  "ok $t\n" : "not ok $t: $a\n";
+  "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
 
 END {
   1 while unlink @f;