In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/313d8687ce0c497b3d341cac2a572742e55a144c?hp=039b3ea2b5ab903aaee0f1a1a89004571e78b740>
- Log ----------------------------------------------------------------- commit 313d8687ce0c497b3d341cac2a572742e55a144c Author: Steve Hay <[email protected]> Date: Tue Aug 9 17:55:29 2016 +0100 Upgrade Encode from version 2.84 to 2.85 This retains the customizations to Byte/Makefile.PL, encoding.pm and various test scripts that have not yet been assimilated. M Porting/Maintainers.pl M cpan/Encode/Encode.pm M cpan/Encode/Encode.xs M cpan/Encode/Makefile.PL M cpan/Encode/bin/enc2xs M cpan/Encode/bin/encguess M cpan/Encode/bin/piconv M cpan/Encode/bin/ucmlint M cpan/Encode/t/Encode.t M cpan/Encode/t/cow.t M cpan/Encode/t/decode.t M cpan/Encode/t/mime-header.t M cpan/Encode/t/utf8warnings.t M t/porting/customized.dat commit e05a9d748f06dec3df0dfe1c43826714864a3d6a Author: Steve Hay <[email protected]> Date: Tue Aug 9 17:36:33 2016 +0100 Upgrade Digest-SHA from version 5.95 to 5.96 M Porting/Maintainers.pl M cpan/Digest-SHA/lib/Digest/SHA.pm M cpan/Digest-SHA/shasum M cpan/Digest-SHA/src/sha.c M cpan/Digest-SHA/src/sha.h M cpan/Digest-SHA/src/sha64bit.c M cpan/Digest-SHA/src/sha64bit.h M t/porting/customized.dat ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 15 +----- cpan/Digest-SHA/lib/Digest/SHA.pm | 8 ++-- cpan/Digest-SHA/shasum | 11 +++-- cpan/Digest-SHA/src/sha.c | 12 ++--- cpan/Digest-SHA/src/sha.h | 6 +-- cpan/Digest-SHA/src/sha64bit.c | 6 +-- cpan/Digest-SHA/src/sha64bit.h | 6 +-- cpan/Encode/Encode.pm | 46 ++++++++++++++++-- cpan/Encode/Encode.xs | 98 +++++++++++++++++++++++++++++++-------- cpan/Encode/Makefile.PL | 5 +- cpan/Encode/bin/enc2xs | 2 +- cpan/Encode/bin/encguess | 2 +- cpan/Encode/bin/piconv | 2 +- cpan/Encode/bin/ucmlint | 4 +- cpan/Encode/t/Encode.t | 65 +++++++++++++++----------- cpan/Encode/t/cow.t | 11 ++++- cpan/Encode/t/decode.t | 15 ++++-- cpan/Encode/t/mime-header.t | 2 +- cpan/Encode/t/utf8warnings.t | 32 ++++++++++++- t/porting/customized.dat | 16 +++---- 20 files changed, 255 insertions(+), 109 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index d426338..38c3c3e 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -385,7 +385,7 @@ use File::Glob qw(:case); }, 'Digest::SHA' => { - 'DISTRIBUTION' => 'MSHELOR/Digest-SHA-5.95.tar.gz', + 'DISTRIBUTION' => 'MSHELOR/Digest-SHA-5.96.tar.gz', 'FILES' => q[cpan/Digest-SHA], 'EXCLUDED' => [ qw( t/pod.t @@ -393,10 +393,6 @@ use File::Glob qw(:case); examples/dups ), ], - 'CUSTOMIZED' => [ - # CVE-2016-1238 - qw( lib/Digest/SHA.pm shasum ) - ], }, 'Dumpvalue' => { @@ -406,7 +402,7 @@ use File::Glob qw(:case); }, 'Encode' => { - 'DISTRIBUTION' => 'DANKOGAI/Encode-2.84.tar.gz', + 'DISTRIBUTION' => 'DANKOGAI/Encode-2.85.tar.gz', 'FILES' => q[cpan/Encode], CUSTOMIZED => [ qw( encoding.pm @@ -419,13 +415,6 @@ use File::Glob qw(:case); t/jperl.t ), ], - 'CUSTOMIZED' => [ - # CVE-2016-1238 - qw( - Encode.pm bin/enc2xs bin/encguess bin/piconv - bin/ucmlint bin/unidump - ) - ], }, 'encoding::warnings' => { diff --git a/cpan/Digest-SHA/lib/Digest/SHA.pm b/cpan/Digest-SHA/lib/Digest/SHA.pm index e696dec..e2c58f6 100644 --- a/cpan/Digest-SHA/lib/Digest/SHA.pm +++ b/cpan/Digest-SHA/lib/Digest/SHA.pm @@ -4,11 +4,11 @@ require 5.003000; use strict; use warnings; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -use Fcntl; +use vars qw($VERSION @ISA @EXPORT_OK); +use Fcntl qw(O_RDONLY); use integer; -$VERSION = '5.95_01'; +$VERSION = '5.96'; require Exporter; require DynaLoader; @@ -813,7 +813,7 @@ darkness and moored it in so perfect a calm and in so brilliant a light" =head1 COPYRIGHT AND LICENSE -Copyright (C) 2003-2015 Mark Shelor +Copyright (C) 2003-2016 Mark Shelor This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/Digest-SHA/shasum b/cpan/Digest-SHA/shasum index 62a2b0e..2721117 100644 --- a/cpan/Digest-SHA/shasum +++ b/cpan/Digest-SHA/shasum @@ -2,10 +2,10 @@ ## shasum: filter for computing SHA digests (ref. sha1sum/md5sum) ## - ## Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved + ## Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved ## - ## Version: 5.95 - ## Sat Jan 10 12:15:36 MST 2015 + ## Version: 5.96 + ## Wed Jul 27 20:04:34 MST 2016 ## shasum SYNOPSIS adapted from GNU Coreutils sha1sum. Add ## "-a" option for algorithm selection, @@ -14,6 +14,7 @@ ## "-p" option for portable digests (to be deprecated). BEGIN { pop @INC if $INC[-1] eq '.' } + use strict; use warnings; use Fcntl; @@ -91,7 +92,7 @@ the 7-bit message I<0001100>: =head1 AUTHOR -Copyright (c) 2003-2015 Mark Shelor <[email protected]>. +Copyright (c) 2003-2016 Mark Shelor <[email protected]>. =head1 SEE ALSO @@ -102,7 +103,7 @@ L<Digest::SHA::PurePerl>. END_OF_POD -my $VERSION = "5.95"; +my $VERSION = "5.96"; sub usage { my($err, $msg) = @_; diff --git a/cpan/Digest-SHA/src/sha.c b/cpan/Digest-SHA/src/sha.c index ea0d41b..fae9bb4 100644 --- a/cpan/Digest-SHA/src/sha.c +++ b/cpan/Digest-SHA/src/sha.c @@ -3,10 +3,10 @@ * * Ref: NIST FIPS PUB 180-4 Secure Hash Standard * - * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved + * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved * - * Version: 5.95 - * Sat Jan 10 12:15:36 MST 2015 + * Version: 5.96 + * Wed Jul 27 20:04:34 MST 2016 * */ @@ -364,10 +364,10 @@ static ULNG shabits(UCHR *bitstr, ULNG bitcnt, SHA *s) for (i = 0UL; i < bitcnt; i++) { if (BITSET(bitstr, i)) - SETBIT(s->block, s->blockcnt), s->blockcnt++; + SETBIT(s->block, s->blockcnt); else - CLRBIT(s->block, s->blockcnt), s->blockcnt++; - if (s->blockcnt == s->blocksize) + CLRBIT(s->block, s->blockcnt); + if (++s->blockcnt == s->blocksize) s->sha(s, s->block), s->blockcnt = 0; } return(bitcnt); diff --git a/cpan/Digest-SHA/src/sha.h b/cpan/Digest-SHA/src/sha.h index e63d4b7..ca34741 100644 --- a/cpan/Digest-SHA/src/sha.h +++ b/cpan/Digest-SHA/src/sha.h @@ -3,10 +3,10 @@ * * Ref: NIST FIPS PUB 180-4 Secure Hash Standard * - * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved + * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved * - * Version: 5.95 - * Sat Jan 10 12:15:36 MST 2015 + * Version: 5.96 + * Wed Jul 27 20:04:34 MST 2016 * */ diff --git a/cpan/Digest-SHA/src/sha64bit.c b/cpan/Digest-SHA/src/sha64bit.c index 2fa0dda..860b52c 100644 --- a/cpan/Digest-SHA/src/sha64bit.c +++ b/cpan/Digest-SHA/src/sha64bit.c @@ -3,10 +3,10 @@ * * Ref: NIST FIPS PUB 180-4 Secure Hash Standard * - * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved + * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved * - * Version: 5.95 - * Sat Jan 10 12:15:36 MST 2015 + * Version: 5.96 + * Wed Jul 27 20:04:34 MST 2016 * */ diff --git a/cpan/Digest-SHA/src/sha64bit.h b/cpan/Digest-SHA/src/sha64bit.h index ce89548..aef4426 100644 --- a/cpan/Digest-SHA/src/sha64bit.h +++ b/cpan/Digest-SHA/src/sha64bit.h @@ -3,10 +3,10 @@ * * Ref: NIST FIPS PUB 180-4 Secure Hash Standard * - * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved + * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved * - * Version: 5.95 - * Sat Jan 10 12:15:36 MST 2015 + * Version: 5.96 + * Wed Jul 27 20:04:34 MST 2016 * * The following macros supply placeholder values that enable the * sha.c module to successfully compile when 64-bit integer types diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm index 041e60c..f9e607a 100644 --- a/cpan/Encode/Encode.pm +++ b/cpan/Encode/Encode.pm @@ -1,10 +1,10 @@ # -# $Id: Encode.pm,v 2.84 2016/04/11 07:16:52 dankogai Exp $ +# $Id: Encode.pm,v 2.85 2016/08/04 03:15:58 dankogai Exp dankogai $ # package Encode; use strict; use warnings; -our $VERSION = sprintf "%d.%02d_01", q$Revision: 2.84 $ =~ /(\d+)/g; +our $VERSION = sprintf "%d.%02d", q$Revision: 2.85 $ =~ /(\d+)/g; use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG}; use XSLoader (); XSLoader::load( __PACKAGE__, $VERSION ); @@ -220,8 +220,34 @@ sub from_to($$$;$) { require Carp; Carp::croak("Unknown encoding '$to'"); } - my $uni = $f->decode($string); - $_[0] = $string = $t->encode( $uni, $check ); + + # For Unicode, warnings need to be caught and re-issued at this level + # so that callers can disable utf8 warnings lexically. + my $uni; + if ( ref($f) eq 'Encode::Unicode' ) { + my $warn = ''; + { + local $SIG{__WARN__} = sub { $warn = shift }; + $uni = $f->decode($string); + } + warnings::warnif('utf8', $warn) if length $warn; + } + else { + $uni = $f->decode($string); + } + + if ( ref($t) eq 'Encode::Unicode' ) { + my $warn = ''; + { + local $SIG{__WARN__} = sub { $warn = shift }; + $_[0] = $string = $t->encode( $uni, $check ); + } + warnings::warnif('utf8', $warn) if length $warn; + } + else { + $_[0] = $string = $t->encode( $uni, $check ); + } + return undef if ( $check && length($uni) ); return defined( $_[0] ) ? length($string) : undef; } @@ -470,6 +496,10 @@ I<ENCODING> and returns a sequence of octets. I<ENCODING> can be either a canonical name or an alias. For encoding names and aliases, see L</"Defining Aliases">. For CHECK, see L</"Handling Malformed Data">. +B<CAVEAT>: the input scalar I<STRING> might be modified in-place depending +on what is set in CHECK. See L</LEAVE_SRC> if you want your inputs to be +left unchanged. + For example, to convert a string from Perl's internal format into ISO-8859-1, also known as Latin1: @@ -494,6 +524,10 @@ I<ENCODING> can be either a canonical name or an alias. For encoding names and aliases, see L</"Defining Aliases">; for I<CHECK>, see L</"Handling Malformed Data">. +B<CAVEAT>: the input scalar I<OCTETS> might be modified in-place depending +on what is set in CHECK. See L</LEAVE_SRC> if you want your inputs to be +left unchanged. + For example, to convert ISO-8859-1 data into a string in Perl's internal format: @@ -609,6 +643,10 @@ Because not all sequences of octets are valid UTF-8, it is quite possible for this function to fail. For CHECK, see L</"Handling Malformed Data">. +B<CAVEAT>: the input I<$octets> might be modified in-place depending on +what is set in CHECK. See L</LEAVE_SRC> if you want your inputs to be +left unchanged. + =head2 Listing available encodings use Encode; diff --git a/cpan/Encode/Encode.xs b/cpan/Encode/Encode.xs index cd7f7d1..b9b079e 100644 --- a/cpan/Encode/Encode.xs +++ b/cpan/Encode/Encode.xs @@ -1,5 +1,5 @@ /* - $Id: Encode.xs,v 2.35 2016/01/22 06:33:07 dankogai Exp $ + $Id: Encode.xs,v 2.36 2016/08/04 03:15:58 dankogai Exp dankogai $ */ #define PERL_NO_GET_CONTEXT @@ -318,6 +318,39 @@ strict_utf8(pTHX_ SV* sv) return SvTRUE(*svp); } +/* + * https://github.com/dankogai/p5-encode/pull/56#issuecomment-231959126 + */ +#ifndef UNICODE_IS_NONCHAR +#define UNICODE_IS_NONCHAR(c) ((c >= 0xFDD0 && c <= 0xFDEF) || (c & 0xFFFE) == 0xFFFE) +#endif + +static UV +convert_utf8_multi_seq(U8* s, STRLEN len, bool strict) +{ + UV uv; + + if (strict && len > 4) + return 0; + + uv = NATIVE_TO_UTF(*s) & UTF_START_MASK(len); + + len--; + s++; + + while (len--) { + if (!UTF8_IS_CONTINUATION(*s)) + return 0; + uv = UTF8_ACCUMULATE(uv, *s); + s++; + } + + if (strict && (UNICODE_IS_SURROGATE(uv) || UNICODE_IS_NONCHAR(uv) || uv > PERL_UNICODE_MAX)) + return 0; + + return uv; +} + static U8* process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, bool encode, bool strict, bool stop_at_partial) @@ -326,6 +359,8 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, STRLEN ulen; SV *fallback_cb; int check; + U8 *d; + STRLEN dlen; if (SvROK(check_sv)) { /* croak("UTF-8 decoder doesn't support callback CHECK"); */ @@ -340,10 +375,12 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, SvPOK_only(dst); SvCUR_set(dst,0); + dlen = (s && e && s < e) ? e-s+1 : 1; + d = (U8 *) SvGROW(dst, dlen); + while (s < e) { if (UTF8_IS_INVARIANT(*s)) { - sv_catpvn(dst, (char *)s, 1); - s++; + *d++ = *s++; continue; } @@ -362,19 +399,12 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, goto malformed_byte; } - uv = utf8n_to_uvuni(s, e - s, &ulen, - UTF8_CHECK_ONLY | (strict ? UTF8_ALLOW_STRICT : - UTF8_ALLOW_NONSTRICT) - ); -#if 1 /* perl-5.8.6 and older do not check UTF8_ALLOW_LONG */ - if (strict && uv > PERL_UNICODE_MAX) - ulen = (STRLEN) -1; -#endif - if (ulen == (STRLEN) -1) { + ulen = skip; + uv = convert_utf8_multi_seq(s, skip, strict); + if (uv == 0) { if (strict) { - uv = utf8n_to_uvuni(s, e - s, &ulen, - UTF8_CHECK_ONLY | UTF8_ALLOW_NONSTRICT); - if (ulen == (STRLEN) -1) + uv = convert_utf8_multi_seq(s, skip, 0); + if (uv == 0) goto malformed_byte; goto malformed; } @@ -383,7 +413,8 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, /* Whole char is good */ - sv_catpvn(dst,(char *)s,skip); + memcpy(d, s, skip); + d += skip; s += skip; continue; } @@ -422,13 +453,25 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv, if (encode){ SvUTF8_off(subchar); /* make sure no decoded string gets in */ } + dlen += SvCUR(subchar) - ulen; + SvCUR_set(dst, d-(U8 *)SvPVX(dst)); + *SvEND(dst) = '\0'; sv_catsv(dst, subchar); SvREFCNT_dec(subchar); + d = (U8 *) SvGROW(dst, dlen) + SvCUR(dst); } else { - sv_catpv(dst, FBCHAR_UTF8); + STRLEN fbcharlen = strlen(FBCHAR_UTF8); + dlen += fbcharlen - ulen; + if (SvLEN(dst) < dlen) { + SvCUR_set(dst, d-(U8 *)SvPVX(dst)); + d = (U8 *) sv_grow(dst, dlen) + SvCUR(dst); + } + memcpy(d, FBCHAR_UTF8, fbcharlen); + d += fbcharlen; } s += ulen; } + SvCUR_set(dst, d-(U8 *)SvPVX(dst)); *SvEND(dst) = '\0'; return s; @@ -455,9 +498,10 @@ CODE: { dSP; ENTER; SAVETMPS; if (src == &PL_sv_undef || SvROK(src)) src = sv_2mortal(newSV(0)); + check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv); + if (!(check & ENCODE_LEAVE_SRC) && SvIsCOW(src)) sv_force_normal(src); // disassociate from any other scalars before doing in-place modifications s = (U8 *) SvPV(src, slen); e = (U8 *) SvEND(src); - check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv); /* * PerlIO check -- we assume the object is of PerlIO if renewed */ @@ -647,8 +691,14 @@ CODE: int check; SV *fallback_cb = &PL_sv_undef; encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj))); + if (SvREADONLY(src) || SvSMAGICAL(src) || SvGMAGICAL(src) || !SvPOK(src)) { + SV *tmp; + tmp = sv_newmortal(); + sv_copypv(tmp, src); + src = tmp; + } if (SvUTF8(src)) { - sv_utf8_downgrade(src, FALSE); + sv_utf8_downgrade(src, FALSE); } if (SvROK(check_sv)){ fallback_cb = check_sv; @@ -672,6 +722,16 @@ CODE: int check; SV *fallback_cb = &PL_sv_undef; encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj))); + if (SvREADONLY(src) || SvSMAGICAL(src) || SvGMAGICAL(src) || !SvPOK(src)) { + /* + SV *tmp; + tmp = sv_newmortal(); + sv_copypv(tmp, src); + src = tmp; + */ + src = sv_mortalcopy(src); + SvPV_force_nolen(src); + } sv_utf8_upgrade(src); if (SvROK(check_sv)){ fallback_cb = check_sv; diff --git a/cpan/Encode/Makefile.PL b/cpan/Encode/Makefile.PL index e0372ca..f885584 100644 --- a/cpan/Encode/Makefile.PL +++ b/cpan/Encode/Makefile.PL @@ -1,5 +1,5 @@ # -# $Id: Makefile.PL,v 2.16 2015/09/24 02:19:21 dankogai Exp $ +# $Id: Makefile.PL,v 2.17 2016/08/04 03:15:58 dankogai Exp dankogai $ # use 5.007003; use strict; @@ -51,6 +51,9 @@ WriteMakefile( Exporter => '5.57', # use Exporter 'import'; parent => '0.221', # version bundled with 5.10.1 }, + TEST_REQUIRES => { + 'Test::More' => '0.81_01', + }, PMLIBDIRS => \@pmlibdirs, INSTALLDIRS => ($] < 5.011 ? 'perl' : 'site'), META_MERGE => { diff --git a/cpan/Encode/bin/enc2xs b/cpan/Encode/bin/enc2xs index f8d9f52..f2a228f 100644 --- a/cpan/Encode/bin/enc2xs +++ b/cpan/Encode/bin/enc2xs @@ -11,7 +11,7 @@ use warnings; use Getopt::Std; use Config; my @orig_ARGV = @ARGV; -our $VERSION = do { my @r = (q$Revision: 2.18 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 2.19 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # These may get re-ordered. # RAW is a do_now as inserted by &enter diff --git a/cpan/Encode/bin/encguess b/cpan/Encode/bin/encguess index 0be5c7c..982449a 100644 --- a/cpan/Encode/bin/encguess +++ b/cpan/Encode/bin/encguess @@ -61,7 +61,7 @@ encguess - guess character encodings of files =head1 VERSION -$Id: encguess,v 0.1 2015/02/05 10:34:19 dankogai Exp $ +$Id: encguess,v 0.2 2016/08/04 03:15:58 dankogai Exp dankogai $ =head1 SYNOPSIS diff --git a/cpan/Encode/bin/piconv b/cpan/Encode/bin/piconv index 60b2a59..8249eee 100644 --- a/cpan/Encode/bin/piconv +++ b/cpan/Encode/bin/piconv @@ -1,5 +1,5 @@ #!./perl -# $Id: piconv,v 2.7 2014/05/31 09:48:48 dankogai Exp $ +# $Id: piconv,v 2.8 2016/08/04 03:15:58 dankogai Exp dankogai $ # BEGIN { pop @INC if $INC[-1] eq '.' } use 5.8.0; diff --git a/cpan/Encode/bin/ucmlint b/cpan/Encode/bin/ucmlint index 25e0d67..0627aae 100644 --- a/cpan/Encode/bin/ucmlint +++ b/cpan/Encode/bin/ucmlint @@ -1,11 +1,11 @@ #!/usr/local/bin/perl # -# $Id: ucmlint,v 2.2 2008/03/12 09:51:11 dankogai Exp $ +# $Id: ucmlint,v 2.3 2016/08/04 03:15:58 dankogai Exp dankogai $ # BEGIN { pop @INC if $INC[-1] eq '.' } use strict; -our $VERSION = do { my @r = (q$Revision: 2.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 2.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Getopt::Std; our %Opt; diff --git a/cpan/Encode/t/Encode.t b/cpan/Encode/t/Encode.t index d490255..d12b2fa 100644 --- a/cpan/Encode/t/Encode.t +++ b/cpan/Encode/t/Encode.t @@ -14,7 +14,7 @@ BEGIN { } } use strict; -use Test; +use Test::More; use Encode qw(from_to encode decode encode_utf8 decode_utf8 find_encoding is_utf8); @@ -25,33 +25,34 @@ my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z'); my @source = qw(ascii iso8859-1 cp1250); my @destiny = qw(cp1047 cp37 posix-bc); my @ebcdic_sets = qw(cp1047 cp37 posix-bc); -plan test => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256 + 6 + 5; +plan tests => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256 + 6 + 5 + 2; + my $str = join('',map(chr($_),0x20..0x7E)); my $cpy = $str; -ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"); -ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode"); +is length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"; +is $cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode"; $cpy = $str; -ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong"); -ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1"); +is from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong"; +is $cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1"; $str = join('',map(chr($_),0xa0..0xff)); $cpy = $str; -ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"); +is length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong"; my $sym = Encode->getEncoding('symbol'); my $uni = $sym->decode(encode(ascii => 'a')); -ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'"); +is "\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'"; $str = $sym->encode("\N{Beta}"); -ok("B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta"); +is "B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta"; foreach my $enc (qw(symbol dingbats ascii),@encodings) { my $tab = Encode->getEncoding($enc); - ok(1,defined($tab),"Could not load $enc"); + is 1,defined($tab),"Could not load $enc"; $str = join('',map(chr($_),0x20..0x7E)); $uni = $tab->decode($str); $cpy = $tab->encode($uni); - ok($cpy,$str,"$enc mangled translating to Unicode and back"); + is $cpy,$str,"$enc mangled translating to Unicode and back"; } # On ASCII based machines see if we can map several codepoints from @@ -78,8 +79,8 @@ foreach my $to (@destiny) my $native_chr = $chr; my $cpy = $chr; my $rc = from_to($cpy,$from,$to); - ok(1,$rc,"Could not translate from $from to $to"); - ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to"); + is 1,$rc,"Could not translate from $from to $to"; + is ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to"; } } } @@ -95,27 +96,27 @@ foreach my $enc_eb (@ebcdic_sets) $str = chr($ord); my $rc = from_to($str,$enc_as,$enc_eb); $rc += from_to($str,$enc_eb,$enc_as); - ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained"); - ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back"); + is $rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained"; + is $ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back"; } } my $mime = find_encoding('iso-8859-2'); -ok(defined($mime),1,"Cannot find MIME-ish'iso-8859-2'"); +is defined($mime),1,"Cannot find MIME-ish'iso-8859-2'"; my $x11 = find_encoding('iso8859-2'); -ok(defined($x11),1,"Cannot find X11-ish 'iso8859-2'"); -ok($mime,$x11,"iso8598-2 and iso-8859-2 not same"); +is defined($x11),1,"Cannot find X11-ish 'iso8859-2'"; +is $mime,$x11,"iso8598-2 and iso-8859-2 not same"; my $spc = find_encoding('iso 8859-2'); -ok(defined($spc),1,"Cannot find 'iso 8859-2'"); -ok($spc,$mime,"iso 8859-2 and iso-8859-2 not same"); +is defined($spc),1,"Cannot find 'iso 8859-2'"; +is $spc,$mime,"iso 8859-2 and iso-8859-2 not same"; for my $i (256,128,129,256) { my $c = chr($i); my $s = "$c\n".sprintf("%02X",$i); - ok(utf8::valid($s),1,"concat of $i botched"); + is utf8::valid($s),1,"concat of $i botched"; utf8::upgrade($s); - ok(utf8::valid($s),1,"concat of $i botched"); + is utf8::valid($s),1,"concat of $i botched"; } # Spot check a few points in/out of utf8 @@ -123,9 +124,9 @@ for my $i (ord('A'),128,256,0x20AC) { my $c = chr($i); my $o = encode_utf8($c); - ok(decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i"); - ok(encode('utf8',$c),$o,"utf8 encode by name broken for $i"); - ok(decode('utf8',$o),$c,"utf8 decode by name broken for $i"); + is decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i"; + is encode('utf8',$c),$o,"utf8 encode by name broken for $i"; + is decode('utf8',$o),$c,"utf8 decode by name broken for $i"; } @@ -158,9 +159,19 @@ ok(decode_utf8(*1), "*main::1"); my $key = (keys %{{ "whatever\x{100}" => '' }})[0]; my $kopy = $key; encode("UTF-16LE", $kopy, Encode::FB_CROAK); -ok $key, "whatever\x{100}", 'encode with shared hash key scalars'; +is $key, "whatever\x{100}", 'encode with shared hash key scalars'; undef $key; $key = (keys %{{ "whatever" => '' }})[0]; $kopy = $key; decode("UTF-16LE", $kopy, Encode::FB_CROAK); -ok $key, "whatever", 'decode with shared hash key scalars'; +is $key, "whatever", 'decode with shared hash key scalars'; + +my $latin1 = find_encoding('latin1'); +my $orig = "\316"; +$orig =~ /(.)/; +is $latin1->encode($1), $orig, '[cpan #115168] passing magic regex globals to encode'; +SKIP: { + skip "Perl Version ($]) is older than v5.16", 1 if $] < 5.016; + *a = $orig; + is $latin1->encode(*a), '*main::'.$orig, '[cpan #115168] passing typeglobs to encode'; +} diff --git a/cpan/Encode/t/cow.t b/cpan/Encode/t/cow.t index 985e268..ab34e05 100644 --- a/cpan/Encode/t/cow.t +++ b/cpan/Encode/t/cow.t @@ -1,9 +1,9 @@ # -# $Id: cow.t,v 1.1 2013/08/29 16:47:39 dankogai Exp $ +# $Id: cow.t,v 1.2 2016/08/04 03:15:58 dankogai Exp dankogai $ # use strict; use Encode (); -use Test::More tests => 2; +use Test::More tests => 4; my %a = ( "L\x{c3}\x{a9}on" => "acme" ); @@ -18,3 +18,10 @@ is $h{"L\x{e9}on"} => 'acme'; # use Devel::Peek; # Dump(\%h); +{ # invalid input to encode/decode/from_to should not affect COW-shared scalars + my $x = Encode::decode('UTF-8', "\303\244" x 4); + my $orig = "$x"; # non-COW copy + is($x, $orig, "copy of original string matches"); + { my $y = $x; Encode::from_to($y, "UTF-8", "iso-8859-1"); } + is($x, $orig, "original scalar unmodified after from_to() call"); +} diff --git a/cpan/Encode/t/decode.t b/cpan/Encode/t/decode.t index 77cdaba..1062c2d 100644 --- a/cpan/Encode/t/decode.t +++ b/cpan/Encode/t/decode.t @@ -1,9 +1,9 @@ # -# $Id: decode.t,v 1.1 2013/08/29 16:47:39 dankogai Exp $ +# $Id: decode.t,v 1.2 2016/08/04 03:15:58 dankogai Exp dankogai $ # use strict; -use Encode qw(decode_utf8 FB_CROAK); -use Test::More tests => 3; +use Encode qw(decode_utf8 FB_CROAK find_encoding decode); +use Test::More tests => 5; sub croak_ok(&) { my $code = shift; @@ -23,3 +23,12 @@ croak_ok { Encode::decode('utf-8', $orig2, FB_CROAK) }; chop(my $new = $bytes . $pad); croak_ok { Encode::decode_utf8($new, FB_CROAK) }; +my $latin1 = find_encoding('latin1'); +$orig = "\N{U+0080}"; +$orig =~ /(.)/; +is($latin1->decode($1), $orig, '[cpan #115168] passing magic regex globals to decode'); +SKIP: { + skip "Perl Version ($]) is older than v5.16", 1 if $] < 5.016; + *a = $orig; + is($latin1->decode(*a), '*main::'.$orig, '[cpan #115168] passing typeglobs to decode'); +} diff --git a/cpan/Encode/t/mime-header.t b/cpan/Encode/t/mime-header.t index a9e6086..4477a4e 100644 --- a/cpan/Encode/t/mime-header.t +++ b/cpan/Encode/t/mime-header.t @@ -1,5 +1,5 @@ # -# $Id: mime-header.t,v 2.12 2016/04/11 07:17:02 dankogai Exp dankogai $ +# $Id: mime-header.t,v 2.12 2016/04/11 07:17:02 dankogai Exp $ # This script is written in utf8 # BEGIN { diff --git a/cpan/Encode/t/utf8warnings.t b/cpan/Encode/t/utf8warnings.t index 9d93ece..0d1ac6d 100644 --- a/cpan/Encode/t/utf8warnings.t +++ b/cpan/Encode/t/utf8warnings.t @@ -8,7 +8,7 @@ BEGIN { } use Encode; -use Test::More tests => 7; +use Test::More tests => 10; my $valid = "\x61\x00\x00\x00"; my $invalid = "\x78\x56\x34\x12"; @@ -24,6 +24,8 @@ my $enc = find_encoding("UTF32-LE"); is("@warnings", "", "Calling decode in Encode::Unicode on valid string produces no warnings"); } + + { @warnings = (); my $ret = Encode::Unicode::decode( $enc, $invalid ); @@ -44,6 +46,8 @@ my $enc = find_encoding("UTF32-LE"); is("@warnings", "", "Warning from decode in Encode::Unicode can be silenced via no warnings"); } + + { @warnings = (); my $ret = Encode::decode( $enc, $invalid ); @@ -61,6 +65,30 @@ my $enc = find_encoding("UTF32-LE"); no warnings; @warnings = (); my $ret = Encode::decode( $enc, $invalid ); - is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings 'utf8'"); + is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings"); +}; + + + +{ + @warnings = (); + my $inplace = $invalid; + Encode::from_to( $inplace, "UTF32-LE", "UTF-8" ); + like("@warnings", qr/is not Unicode/, "Calling from_to in Encode on invalid string warns"); +} + +{ + no warnings 'utf8'; + @warnings = (); + my $inplace = $invalid; + Encode::from_to( $inplace, "UTF32-LE", "UTF-8" ); + is("@warnings", "", "Warning from from_to in Encode can be silenced via no warnings 'utf8'"); }; +{ + no warnings; + @warnings = (); + my $inplace = $invalid; + Encode::from_to( $inplace, "UTF32-LE", "UTF-8" ); + is("@warnings", "", "Warning from from_to in Encode can be silenced via no warnings"); +}; diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 706434d..c13e935 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -2,14 +2,14 @@ CPAN cpan/CPAN/lib/App/Cpan.pm 3cef68c2a44a4996b432bc25622e3a544a188aa5 CPAN cpan/CPAN/lib/CPAN.pm 4616a44963045f7bd07bb7f8e5f99bbd789af4e5 CPAN cpan/CPAN/scripts/cpan 22610ed0301d48a269d1739afd2f7f84359d956f Digest cpan/Digest/Digest.pm 43f7f544cb11842b2f55c73e28930da50774e081 -Digest::SHA cpan/Digest-SHA/lib/Digest/SHA.pm 5841fcf70f7290e07befdd16f05093664c618a96 -Digest::SHA cpan/Digest-SHA/shasum f92faa37afc098e2a825e4ecda1097890492d957 -Encode cpan/Encode/bin/enc2xs 7bbd4ca8d81e0189b87d703aa058b95a837b97d3 -Encode cpan/Encode/bin/encguess f1e7a130995c4bad53bb6d3034dae625cfe61e32 -Encode cpan/Encode/bin/piconv 80ea7f9afff580e41c4b29f5ab214ed378274b49 -Encode cpan/Encode/bin/ucmlint 495862125269a60536b78fd0a7910d024c4d21fe -Encode cpan/Encode/bin/unidump 715f47c2fcc661268f3c6cd3de0d27c72b745cd2 -Encode cpan/Encode/Encode.pm 8c876d97ab6b8539254b707a00fae2be47464225 +Encode cpan/Encode/Byte/Makefile.PL 54f446297d614331ef3f51e8310faff27cc44f90 +Encode cpan/Encode/encoding.pm 90ea1844e5ae863a17dd40ac6a0f27f438db9c1f +Encode cpan/Encode/t/enc_data.t e8b94d651a6519e186a2b74245f0002c4bb62160 +Encode cpan/Encode/t/enc_eucjp.t 9d73fce7d5ae83036be546d1603262baffd68cdb +Encode cpan/Encode/t/enc_module.t aad4fcde7389ad55731206f62284dadf21ffe274 +Encode cpan/Encode/t/enc_utf8.t 7d1c9a4260c0c6b263eff30539e591c417e602a9 +Encode cpan/Encode/t/encoding.t ed051c17c92510713b24217c22384815088834a8 +Encode cpan/Encode/t/jperl.t 584a3813e7bc680ee6ec1d54253bbf861bda8215 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t a0369c919e216fb02767a637666bb4577ad79b02 File::Fetch cpan/File-Fetch/lib/File/Fetch.pm bd0b64a1d8ee2ffac39e017f9fa9f78f95514b4d File::Path cpan/File-Path/lib/File/Path.pm fd8ce4420a0c113d3f47dd3223859743655c1da8 -- Perl5 Master Repository
