From: Rafael Garcia-Suarez Date: Sun, 20 Dec 2009 22:17:00 +0000 (+0100) Subject: Upgrade to Encode 2.39 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b9627ca0e5018428a0c9716cd6161b63cbc42db8;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Encode 2.39 --- diff --git a/cpan/Encode/AUTHORS b/cpan/Encode/AUTHORS index a470e57..bdbf08d 100644 --- a/cpan/Encode/AUTHORS +++ b/cpan/Encode/AUTHORS @@ -32,6 +32,7 @@ H.Merijn Brand Hugo van der Sanden Inaba Hiroto Jarkko Hietaniemi +Jesse Vincent Jungshik Shin KONNO Hiroharu Laszlo Molnar diff --git a/cpan/Encode/Changes b/cpan/Encode/Changes index 6c045f7..37868a0 100644 --- a/cpan/Encode/Changes +++ b/cpan/Encode/Changes @@ -1,7 +1,14 @@ # Revision history for Perl extension Encode. # -# $Id: Changes,v 2.38 2009/11/16 14:08:13 dankogai Exp dankogai $ -$Revision: 2.38 $ $Date: 2009/11/16 14:08:13 $ +# $Id: Changes,v 2.39 2009/11/26 09:23:59 dankogai Exp dankogai $ +! Encode.xs t/fallback.t + $utf8 = decode('utf8', $malformed, sub{ ... }) # now works! + http://rt.cpan.org/Ticket/Display.html?id=51204 +! t/CJKT.t t/guess.t t/perlio.t + $ENV{'PERL_CORE'} tricks removed since they are no longer necessary. + Message-Id: <20091116161513.GA25556@bestpractical.com> + +$Revision: 2.39 $ $Date: 2009/11/26 09:23:59 $ ! Encode.xs Addressed: Encode memory corruption [perl #70528] Message-Id: diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm index 267642c..f1dff78 100644 --- a/cpan/Encode/Encode.pm +++ b/cpan/Encode/Encode.pm @@ -1,10 +1,10 @@ # -# $Id: Encode.pm,v 2.38 2009/11/16 14:08:01 dankogai Exp $ +# $Id: Encode.pm,v 2.39 2009/11/26 09:23:48 dankogai Exp $ # package Encode; use strict; use warnings; -our $VERSION = sprintf "%d.%02d", q$Revision: 2.38 $ =~ /(\d+)/g; +our $VERSION = sprintf "%d.%02d", q$Revision: 2.39 $ =~ /(\d+)/g; sub DEBUG () { 0 } use XSLoader (); XSLoader::load( __PACKAGE__, $VERSION ); diff --git a/cpan/Encode/Encode.xs b/cpan/Encode/Encode.xs index 5b8d84c..b2e9127 100644 --- a/cpan/Encode/Encode.xs +++ b/cpan/Encode/Encode.xs @@ -1,5 +1,5 @@ /* - $Id: Encode.xs,v 2.17 2009/11/16 14:08:13 dankogai Exp dankogai $ + $Id: Encode.xs,v 2.18 2009/11/26 09:23:59 dankogai Exp dankogai $ */ #define PERL_NO_GET_CONTEXT @@ -301,11 +301,23 @@ strict_utf8(pTHX_ SV* sv) } static U8* -process_utf8(pTHX_ SV* dst, U8* s, U8* e, int check, +process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, bool encode, bool strict, bool stop_at_partial) { UV uv; STRLEN ulen; + SV *fallback_cb; + int check; + + if (SvROK(check_sv)) { + /* croak("UTF-8 decoder doesn't support callback CHECK"); */ + fallback_cb = check_sv; + check = ENCODE_PERLQQ|ENCODE_LEAVE_SRC; /* same as perlqq */ + } + else { + fallback_cb = &PL_sv_undef; + check = SvIV(check_sv); + } SvPOK_only(dst); SvCUR_set(dst,0); @@ -378,9 +390,16 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, int check, break; } if (check & (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){ - SV* subchar = newSVpvf(check & ENCODE_PERLQQ ? (ulen == 1 ? "\\x%02" UVXf : "\\x{%04" UVXf "}"): - check & ENCODE_HTMLCREF ? "&#%" UVuf ";" : - "&#x%" UVxf ";", uv); + SV* subchar = + (fallback_cb != &PL_sv_undef) + ? do_fallback_cb(aTHX_ uv, fallback_cb) + : newSVpvf(check & ENCODE_PERLQQ + ? (ulen == 1 ? "\\x%02" UVXf : "\\x{%04" UVXf "}") + : check & ENCODE_HTMLCREF ? "&#%" UVuf ";" + : "&#x%" UVxf ";", uv); + if (encode){ + SvUTF8_off(subchar); /* make sure no decoded string gets in */ + } sv_catsv(dst, subchar); SvREFCNT_dec(subchar); } else { @@ -413,17 +432,11 @@ PREINIT: CODE: { dSP; ENTER; SAVETMPS; - if (SvROK(check_sv)) { - croak("UTF-8 decoder doesn't support callback CHECK"); - } - else { - check = SvIV(check_sv); - } if (src == &PL_sv_undef) src = newSV(0); s = (U8 *) SvPV(src, slen); e = (U8 *) SvEND(src); dst = newSV(slen>0?slen:1); /* newSV() abhors 0 -- inaba */ - + check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv); /* * PerlIO check -- we assume the object is of PerlIO if renewed */ @@ -453,7 +466,7 @@ CODE: } } - s = process_utf8(aTHX_ dst, s, e, check, 0, strict_utf8(aTHX_ obj), renewed); + s = process_utf8(aTHX_ dst, s, e, check_sv, 0, strict_utf8(aTHX_ obj), renewed); /* Clear out translated part of source unless asked not to */ if (check && !(check & ENCODE_LEAVE_SRC)){ @@ -482,12 +495,7 @@ PREINIT: int check; CODE: { - if (SvROK(check_sv)) { - croak("UTF-8 encoder doesn't support callback CHECK"); - } - else { - check = SvIV(check_sv); - } + check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv); if (src == &PL_sv_undef) src = newSV(0); s = (U8 *) SvPV(src, slen); e = (U8 *) SvEND(src); @@ -495,7 +503,7 @@ CODE: if (SvUTF8(src)) { /* Already encoded */ if (strict_utf8(aTHX_ obj)) { - s = process_utf8(aTHX_ dst, s, e, check, 1, 1, 0); + s = process_utf8(aTHX_ dst, s, e, check_sv, 1, 1, 0); } else { /* trust it and just copy the octets */ diff --git a/cpan/Encode/META.yml b/cpan/Encode/META.yml index 70090af..2a5c1ab 100644 --- a/cpan/Encode/META.yml +++ b/cpan/Encode/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: Encode -version: 2.38 +version: 2.39 abstract: ~ author: [] license: unknown diff --git a/cpan/Encode/Unicode/Unicode.xs b/cpan/Encode/Unicode/Unicode.xs index d8ef569..9741626 100644 --- a/cpan/Encode/Unicode/Unicode.xs +++ b/cpan/Encode/Unicode/Unicode.xs @@ -1,5 +1,5 @@ /* - $Id: Unicode.xs,v 2.6 2009/11/16 14:08:13 dankogai Exp dankogai $ + $Id: Unicode.xs,v 2.6 2009/11/16 14:08:13 dankogai Exp $ */ #define PERL_NO_GET_CONTEXT diff --git a/cpan/Encode/t/Unicode.t b/cpan/Encode/t/Unicode.t index d6dd1ec..baa502c 100644 --- a/cpan/Encode/t/Unicode.t +++ b/cpan/Encode/t/Unicode.t @@ -1,5 +1,5 @@ # -# $Id: Unicode.t,v 2.2 2009/11/16 14:08:13 dankogai Exp dankogai $ +# $Id: Unicode.t,v 2.2 2009/11/16 14:08:13 dankogai Exp $ # # This script is written entirely in ASCII, even though quoted literals # do include non-BMP unicode characters -- Are you happy, jhi? diff --git a/cpan/Encode/t/fallback.t b/cpan/Encode/t/fallback.t index f6fcc5a..8ef8ab3 100644 --- a/cpan/Encode/t/fallback.t +++ b/cpan/Encode/t/fallback.t @@ -17,7 +17,7 @@ BEGIN { use strict; #use Test::More qw(no_plan); -use Test::More tests => 48; +use Test::More tests => 50; use Encode q(:all); my $uo = ''; @@ -175,3 +175,10 @@ $dst = $ascii->decode($src, sub{ $_[0] }); is $dst, 0xFF."", qq{$ascii->encode(\$src, sub{ \$_[0] } )}; $dst = decode("ascii", (pack "C*", 0xFF), sub{ $_[0] }); is $dst, 0xFF."", qq{decode("ascii", (pack "C*", 0xFF), sub{ \$_[0] })}; + + +$src = pack "C*", 0x80; +$dst = $utf8->decode($src, sub{ $_[0] }); +is $dst, 0x80."", qq{$utf8->encode(\$src, sub{ \$_[0] } )}; +$dst = decode("utf8", $src, sub{ $_[0] }); +is $dst, 0x80."", qq{decode("utf8", (pack "C*", 0x80), sub{ \$_[0] })}; diff --git a/cpan/Encode/t/piconv.t b/cpan/Encode/t/piconv.t index ee8a814..ed084b4 100644 --- a/cpan/Encode/t/piconv.t +++ b/cpan/Encode/t/piconv.t @@ -1,5 +1,5 @@ # -# $Id: piconv.t,v 0.3 2009/11/16 14:08:13 dankogai Exp dankogai $ +# $Id: piconv.t,v 0.3 2009/11/16 14:08:13 dankogai Exp $ # BEGIN {