diff options
Diffstat (limited to 'gnu/usr.bin/perl/ext/PerlIO-encoding')
| -rw-r--r-- | gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm | 2 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.xs | 45 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t | 22 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t | 27 |
4 files changed, 45 insertions, 51 deletions
diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm index 13cb20b3bd9..3d740b181a9 100644 --- a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm +++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm @@ -1,7 +1,7 @@ package PerlIO::encoding; use strict; -our $VERSION = '0.24'; +our $VERSION = '0.26'; our $DEBUG = 0; $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.xs b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.xs index ee0836ff730..941d7862666 100644 --- a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.xs +++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.xs @@ -203,7 +203,7 @@ PerlIOEncode_get_base(pTHX_ PerlIO * f) e->base.bufsiz = 1024; if (!e->bufsv) { e->bufsv = newSV(e->base.bufsiz); - sv_setpvn(e->bufsv, "", 0); + SvPVCLEAR(e->bufsv); } e->base.buf = (STDCHAR *) SvPVX(e->bufsv); if (!e->base.ptr) @@ -307,42 +307,19 @@ PerlIOEncode_fill(pTHX_ PerlIO * f) goto end_of_file; } } - if (SvCUR(e->dataSV)) { - /* something left over from last time - create a normal - SV with new data appended - */ - if (use + SvCUR(e->dataSV) > e->base.bufsiz) { - if (e->flags & NEEDS_LINES) { - /* Have to grow buffer */ - e->base.bufsiz = use + SvCUR(e->dataSV); - PerlIOEncode_get_base(aTHX_ f); - } - else { - use = e->base.bufsiz - SvCUR(e->dataSV); - } - } - sv_catpvn(e->dataSV,(char*)ptr,use); - } - else { - /* Create a "dummy" SV to represent the available data from layer below */ - if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) { - Safefree(SvPVX_mutable(e->dataSV)); - } - if (use > (SSize_t)e->base.bufsiz) { - if (e->flags & NEEDS_LINES) { - /* Have to grow buffer */ - e->base.bufsiz = use; - PerlIOEncode_get_base(aTHX_ f); - } - else { - use = e->base.bufsiz; + if (!SvCUR(e->dataSV)) + SvPVCLEAR(e->dataSV); + if (use + SvCUR(e->dataSV) > e->base.bufsiz) { + if (e->flags & NEEDS_LINES) { + /* Have to grow buffer */ + e->base.bufsiz = use + SvCUR(e->dataSV); + PerlIOEncode_get_base(aTHX_ f); } + else { + use = e->base.bufsiz - SvCUR(e->dataSV); } - SvPV_set(e->dataSV, (char *) ptr); - SvLEN_set(e->dataSV, 0); /* Hands off sv.c - it isn't yours */ - SvCUR_set(e->dataSV,use); - SvPOK_only(e->dataSV); } + sv_catpvn(e->dataSV,(char*)ptr,use); SvUTF8_off(e->dataSV); PUSHMARK(sp); XPUSHs(e->enc); diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t index cba14a82439..41cefcb1377 100755 --- a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t +++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t @@ -16,7 +16,7 @@ BEGIN { require "../../t/charset_tools.pl"; } -use Test::More tests => 24; +use Test::More tests => 27; my $grk = "grk$$"; my $utf = "utf$$"; @@ -25,7 +25,7 @@ my $fail2 = "fb$$"; my $russki = "koi8r$$"; my $threebyte = "3byte$$"; -if (open(GRK, ">$grk")) { +if (open(GRK, '>', $grk)) { binmode(GRK, ":bytes"); # alpha beta gamma in ISO 8859-7 print GRK "\xe1\xe2\xe3"; @@ -40,7 +40,7 @@ if (open(GRK, ">$grk")) { close($i); } -if (open(UTF, "<$utf")) { +if (open(UTF, '<', $utf)) { binmode(UTF, ":bytes"); # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3) @@ -57,7 +57,7 @@ if (open(UTF, "<$utf")) { close($i); } -if (open(GRK, "<$grk")) { +if (open(GRK, '<', $grk)) { binmode(GRK, ":bytes"); is(scalar <GRK>, "\xe1\xe2\xe3"); close GRK; @@ -68,10 +68,10 @@ $SIG{__WARN__} = sub {$warn .= $_[0]}; is (open(FAIL, ">:encoding(NoneSuch)", $fail1), undef, 'Open should fail'); like($warn, qr/^Cannot find encoding "NoneSuch" at/); -is(open(RUSSKI, ">$russki"), 1); +is(open(RUSSKI, '>', $russki), 1); print RUSSKI "\x3c\x3f\x78"; close RUSSKI or die "Could not close: $!"; -open(RUSSKI, "$russki"); +open(RUSSKI, '<', $russki); binmode(RUSSKI, ":raw"); my $buf1; read(RUSSKI, $buf1, 1); @@ -231,6 +231,16 @@ is $x, "To hymn him who heard her herd herd\n", } # SKIP +# decoding shouldn't mutate the original bytes [perl #132833] +{ + my $b = "a\0b\0\n\0"; + open my $fh, "<:encoding(UTF16-LE)", \$b or die; + is scalar(<$fh>), "ab\n"; + is $b, "a\0b\0\n\0"; + close $fh or die; + is $b, "a\0b\0\n\0"; +} + END { 1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte); } diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t index 17c241c17a0..3abdfd3f37c 100755 --- a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t +++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t @@ -16,7 +16,7 @@ BEGIN { import Encode qw(:fallback_all); } -use Test::More tests => 9; +use Test::More tests => 10; # $PerlIO::encoding = 0; # WARN_ON_ERR|PERLQQ; @@ -33,7 +33,7 @@ my $file = "fallback$$.txt"; like($message, qr/does not map to iso-8859-1/o, "FB_WARN message"); } -open($fh,$file) || die "File cannot be re-opened"; +open($fh,'<',$file) || die "File cannot be re-opened"; my $line = <$fh>; is($line,"\\x{20ac}0.02\n","perlqq escapes"); close($fh); @@ -45,14 +45,14 @@ my $str = "\x{20AC}"; print $fh $str,"0.02\n"; close($fh); -open($fh,$file) || die "File cannot be re-opened"; +open($fh,'<',$file) || die "File cannot be re-opened"; my $line = <$fh>; is($line,"€0.02\n","HTML escapes"); close($fh); { no utf8; - open($fh,">$file") || die "File cannot be re-opened"; + open($fh,'>',$file) || die "File cannot be re-opened"; binmode($fh); print $fh "\xA30.02\n"; close($fh); @@ -64,13 +64,20 @@ printf "# %x\n",ord($line); is($line,"\\xA30.02\n","Escaped non-mapped char"); close($fh); -$PerlIO::encoding::fallback = Encode::WARN_ON_ERROR; +{ + my $message = ''; + local $SIG{__WARN__} = sub { $message = $_[0] }; -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); + $PerlIO::encoding::fallback = Encode::WARN_ON_ERR; + + 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); + + like($message, qr/does not map to Unicode/o, "FB_WARN message"); +} END { 1 while unlink($file); |