From: Nick Ing-Simmons Date: Sun, 28 Apr 2002 10:08:05 +0000 (+0000) Subject: Have :encoding() default to perlqq style fallbacks. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1982da4048668033f4bb857b02c690606711056a;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 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,"€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,"; +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,"; +printf "# %x\n",ord($line); +is($line,"\x{FFFD}0.02\n","Unicode replacement char"); +close($fh); + +END { +# unlink($file); +} + + +