Have :encoding() default to perlqq style fallbacks.

Add test for that.

p4raw-id: //depot/perlio@16246

diff --git a/MANIFEST b/MANIFEST
index 5e53c16..823207a 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -526,6 +526,7 @@ ext/PerlIO/Scalar/Makefile.PL       PerlIO layer for scalars
 ext/PerlIO/Scalar/Scalar.pm    PerlIO layer for scalars
 ext/PerlIO/Scalar/Scalar.xs    PerlIO layer for scalars
 ext/PerlIO/t/encoding.t                See if PerlIO encoding conversion works
+ext/PerlIO/t/fallback.t                See if PerlIO fallbacks work
 ext/PerlIO/t/scalar.t          See if PerlIO::Scalar works
 ext/PerlIO/t/via.t             See if PerlIO::Via works
 ext/PerlIO/Via/Makefile.PL     PerlIO layer for layers in perl
@@ -1041,7 +1042,7 @@ lib/ExtUtils/t/Command.t  See if ExtUtils::Command works (Win32 only)
 lib/ExtUtils/t/Constant.t      See if ExtUtils::Constant works
 lib/ExtUtils/t/Embed.t         See if ExtUtils::Embed and embedding works
 lib/ExtUtils/t/hints.t          See if hint files are honored.
-lib/ExtUtils/t/INST.t           Check MakeMaker INST_* macros 
+lib/ExtUtils/t/INST.t           Check MakeMaker INST_* macros
 lib/ExtUtils/t/Installed.t     See if ExtUtils::Installed works
 lib/ExtUtils/t/INST_PREFIX.t    See if MakeMaker can apply PREFIXs
 lib/ExtUtils/t/Manifest.t      See if ExtUtils::Manifest works

diff --git a/ext/PerlIO/encoding/encoding.pm b/ext/PerlIO/encoding/encoding.pm
index 1d91d6d..327baeb 100644 (file)
--- a/ext/PerlIO/encoding/encoding.pm
+++ b/ext/PerlIO/encoding/encoding.pm
@@ -1,18 +1,19 @@
 package PerlIO::encoding;
 use strict;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 our $DEBUG = 0;
 $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
 
 #
-# Equivalent of these are done in encoding.xs - do not uncomment them.
+# Equivalent of this is done in encoding.xs - do not uncomment.
 #
 # use Encode ();
-# our $check;
 
 use XSLoader ();
 XSLoader::load(__PACKAGE__, $VERSION);
 
+our $fallback = Encode::PERLQQ()|Encode::WARN_ON_ERR;
+
 1;
 __END__
 

diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 0293cee..0a6ab10 100644 (file)
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -49,7 +49,7 @@ typedef struct {
 } PerlIOEncode;
 
 #define NEEDS_LINES    1
-#define OUR_DEFAULT_FB "Encode::FB_QUIET"
+#define OUR_DEFAULT_FB "Encode::PERLQQ"
 
 SV *
 PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
@@ -145,7 +145,7 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg)
        PerlIOBase(f)->flags |= PERLIO_F_UTF8;
     }
 
-    e->chk = newSVsv(get_sv("PerlIO::encoding::check", 0));
+    e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0));
 
     FREETMPS;
     LEAVE;
@@ -607,7 +607,7 @@ PROTOTYPES: ENABLE
 
 BOOT:
 {
-    SV *chk = get_sv("PerlIO::encoding::check", GV_ADD|GV_ADDMULTI);
+    SV *chk = get_sv("PerlIO::encoding::fallback", GV_ADD|GV_ADDMULTI);
     /*
      * we now "use Encode ()" here instead of
      * PerlIO/encoding.pm.  This avoids SEGV when ":encoding()"

diff --git a/ext/PerlIO/t/fallback.t b/ext/PerlIO/t/fallback.t
new file mode 100644 (file)
index 0000000..fd1b30c
--- /dev/null
+++ b/ext/PerlIO/t/fallback.t
@@ -0,0 +1,63 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "../t/test.pl";
+    skip_all("No perlio") unless (find PerlIO::Layer 'perlio');
+    plan (8);
+}
+use Encode qw(:fallback_all);
+
+# $PerlIO::encoding = 0; # WARN_ON_ERR|PERLQQ;
+
+my $file = "fallback$$.txt";
+
+$PerlIO::encoding::fallback = Encode::PERLQQ;
+
+ok(open(my $fh,">encoding(iso-8859-1)",$file),"opened iso-8859-1 file");
+my $str = "\x{20AC}";
+print $fh $str,"0.02\n";
+close($fh);
+
+open($fh,$file) || die "File cannot be re-opened";
+my $line = <$fh>;
+is($line,"\\x{20ac}0.02\n","perlqq escapes");
+close($fh);
+
+$PerlIO::encoding::fallback = Encode::HTMLCREF;
+
+ok(open(my $fh,">encoding(iso-8859-1)",$file),"opened iso-8859-1 file");
+my $str = "\x{20AC}";
+print $fh $str,"0.02\n";
+close($fh);
+
+open($fh,$file) || die "File cannot be re-opened";
+my $line = <$fh>;
+is($line,"&#8364;0.02\n","HTML escapes");
+close($fh);
+
+open($fh,">$file") || die "File cannot be re-opened";
+print $fh "£0.02\n";
+close($fh);
+
+ok(open($fh,"<encoding(US-ASCII)",$file),"Opened as ASCII");
+my $line = <$fh>;
+printf "# %x\n",ord($line);
+is($line,"\\xA30.02\n","Escaped non-mapped char");
+close($fh);
+
+$PerlIO::encoding::fallback = Encode::WARN_ON_ERROR;
+
+ok(open($fh,"<encoding(US-ASCII)",$file),"Opened as ASCII");
+my $line = <$fh>;
+printf "# %x\n",ord($line);
+is($line,"\x{FFFD}0.02\n","Unicode replacement char");
+close($fh);
+
+END {
+#   unlink($file);
+}
+
+
+