This is an automated email from the git hooks/post-receive script. anuradha-guest pushed a commit to tag 2.64 in repository libencode-perl.
commit a6c2ba385875c2c03bd42350e23aef0188fb23b0 Author: David Golden <[email protected]> Date: Fri Oct 24 22:26:31 2014 -0400 Catch and re-issue utf8 warnings at a higher level This catches Encode::Unicode warnings and re-issues them from Encode, so that callers can disable warnings lexically with `no warnings 'utf8'`. Fixes https://rt.cpan.org/Ticket/Display.html?id=88592 --- Encode.pm | 30 ++++++++++++++++++++++++++-- t/utf8warnings.t | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 88 insertions(+), 2 deletions(-) diff --git a/Encode.pm b/Encode.pm index 03eded6..09c44b1 100644 --- a/Encode.pm +++ b/Encode.pm @@ -156,7 +156,20 @@ sub encode($$;$) { require Carp; Carp::croak("Unknown encoding '$name'"); } - my $octets = $enc->encode( $string, $check ); + # For Unicode, warnings need to be caught and re-issued at this level + # so that callers can disable utf8 warnings lexically. + my $octets; + if ( ref($enc) eq 'Encode::Unicode' ) { + my $warn = ''; + { + local $SIG{__WARN__} = sub { $warn = shift }; + $octets = $enc->encode( $string, $check ); + } + warnings::warnif('utf8', $warn) if length $warn; + } + else { + $octets = $enc->encode( $string, $check ); + } $_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC() ); return $octets; } @@ -172,7 +185,20 @@ sub decode($$;$) { require Carp; Carp::croak("Unknown encoding '$name'"); } - my $string = $enc->decode( $octets, $check ); + # For Unicode, warnings need to be caught and re-issued at this level + # so that callers can disable utf8 warnings lexically. + my $string; + if ( ref($enc) eq 'Encode::Unicode' ) { + my $warn = ''; + { + local $SIG{__WARN__} = sub { $warn = shift }; + $string = $enc->decode( $octets, $check ); + } + warnings::warnif('utf8', $warn) if length $warn; + } + else { + $string = $enc->decode( $octets, $check ); + } $_[1] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() ); return $string; } diff --git a/t/utf8warnings.t b/t/utf8warnings.t new file mode 100644 index 0000000..24af470 --- /dev/null +++ b/t/utf8warnings.t @@ -0,0 +1,60 @@ +use strict; +use warnings; + +use Encode; +use Test::More tests => 7; + +my $valid = "\x61\x00\x00\x00"; +my $invalid = "\x78\x56\x34\x12"; + +my @warnings; +$SIG{__WARN__} = sub {push @warnings, "@_"}; + +my $enc = find_encoding("UTF32-LE"); + +{ + @warnings = (); + my $ret = Encode::Unicode::decode( $enc, $valid ); + is("@warnings", "", "Calling decode in Encode::Unicode on valid string produces no warnings"); +} + +{ + @warnings = (); + my $ret = Encode::Unicode::decode( $enc, $invalid ); + like("@warnings", qr/is not Unicode/, "Calling decode in Encode::Unicode on invalid string warns"); +} + +{ + no warnings 'utf8'; + @warnings = (); + my $ret = Encode::Unicode::decode( $enc, $invalid ); + is("@warnings", "", "Warning from decode in Encode::Unicode can be silenced via no warnings 'utf8'"); +} + +{ + no warnings; + @warnings = (); + my $ret = Encode::Unicode::decode( $enc, $invalid ); + is("@warnings", "", "Warning from decode in Encode::Unicode can be silenced via no warnings"); +} + +{ + @warnings = (); + my $ret = Encode::decode( $enc, $invalid ); + like("@warnings", qr/is not Unicode/, "Calling decode in Encode on invalid string warns"); +} + +{ + no warnings 'utf8'; + @warnings = (); + my $ret = Encode::decode( $enc, $invalid ); + is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings 'utf8'"); +}; + +{ + no warnings; + @warnings = (); + my $ret = Encode::decode( $enc, $invalid ); + is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings 'utf8'"); +}; + -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libencode-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
