mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
Upgrade to Encode 1.66.
p4raw-id: //depot/perl@16300
This commit is contained in:
Jarkko Hietaniemi
parent
34f67e08c0
commit
4089adc46e
@ -1,9 +1,22 @@
|
||||
# Revision history for Perl extension Encode.
|
||||
#
|
||||
# $Id: Changes,v 1.65 2002/04/30 16:13:37 dankogai Exp dankogai $
|
||||
# $Id: Changes,v 1.66 2002/05/01 05:41:06 dankogai Exp dankogai $
|
||||
#
|
||||
|
||||
$Revision: 1.65 $ $Date: 2002/04/30 16:13:37 $
|
||||
$Revision: 1.66 $ $Date: 2002/05/01 05:41:06 $
|
||||
! Encode.xs t/fallback.t
|
||||
WARN_ON_ERR no longer assumes RETURN_ON_ERR so you can issue a warning
|
||||
while fallback is in effect. This even came with a welcome side-effect
|
||||
of cleaner code with less nests! Thank you, NI-XS. t/fallback.t is
|
||||
also modified to test this.
|
||||
And of course, the corresponding varialbles to UV[Xx]f are appropriately
|
||||
cast. This should've concluded NI-XS homework.
|
||||
! Encode.pm
|
||||
encode(undef) does warn again! Repented upon suggestion by NI-XS.
|
||||
Document for unless vs. '' added
|
||||
Message-Id: <20020430171547.3322.13@bactrian.elixent.com>
|
||||
|
||||
1.65 2002/04/30 16:13:37
|
||||
! Encode.pm
|
||||
encode(undef) no longer warns for C<Use of uninitialized value in
|
||||
subroutine entry>. Suggested by Paul.
|
||||
@ -553,7 +566,7 @@ $Revision: 1.65 $ $Date: 2002/04/30 16:13:37 $
|
||||
Typo fixes and improvements by jhi
|
||||
Message-Id: <200204010201.FAA03564@alpha.hut.fi>, et al.
|
||||
|
||||
1.11 $Date: 2002/04/30 16:13:37 $
|
||||
1.11 $Date: 2002/05/01 05:41:06 $
|
||||
+ t/encoding.t
|
||||
+ t/jperl.t
|
||||
! MANIFEST
|
||||
|
||||
@ -1,9 +1,9 @@
|
||||
#
|
||||
# $Id: Encode.pm,v 1.65 2002/04/30 16:13:37 dankogai Exp dankogai $
|
||||
# $Id: Encode.pm,v 1.66 2002/05/01 05:41:06 dankogai Exp dankogai $
|
||||
#
|
||||
package Encode;
|
||||
use strict;
|
||||
our $VERSION = do { my @r = (q$Revision: 1.65 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
|
||||
our $VERSION = do { my @r = (q$Revision: 1.66 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
|
||||
our $DEBUG = 0;
|
||||
use XSLoader ();
|
||||
XSLoader::load(__PACKAGE__, $VERSION);
|
||||
@ -131,7 +131,6 @@ sub resolve_alias {
|
||||
sub encode($$;$)
|
||||
{
|
||||
my ($name, $string, $check) = @_;
|
||||
defined $string or return;
|
||||
$check ||=0;
|
||||
my $enc = find_encoding($name);
|
||||
unless(defined $enc){
|
||||
@ -146,7 +145,6 @@ sub encode($$;$)
|
||||
sub decode($$;$)
|
||||
{
|
||||
my ($name,$octets,$check) = @_;
|
||||
defined $octets or return;
|
||||
$check ||=0;
|
||||
my $enc = find_encoding($name);
|
||||
unless(defined $enc){
|
||||
@ -161,7 +159,6 @@ sub decode($$;$)
|
||||
sub from_to($$$;$)
|
||||
{
|
||||
my ($string,$from,$to,$check) = @_;
|
||||
defined $string or return;
|
||||
$check ||=0;
|
||||
my $f = find_encoding($from);
|
||||
unless (defined $f){
|
||||
@ -183,7 +180,6 @@ sub from_to($$$;$)
|
||||
sub encode_utf8($)
|
||||
{
|
||||
my ($str) = @_;
|
||||
defined $str or return;
|
||||
utf8::encode($str);
|
||||
return $str;
|
||||
}
|
||||
@ -191,7 +187,6 @@ sub encode_utf8($)
|
||||
sub decode_utf8($)
|
||||
{
|
||||
my ($str) = @_;
|
||||
defined $str or return;
|
||||
return undef unless utf8::decode($str);
|
||||
return $str;
|
||||
}
|
||||
@ -366,6 +361,10 @@ for $octets is B<always> off. When you encode anything, utf8 flag of
|
||||
the result is always off, even when it contains completely valid utf8
|
||||
string. See L</"The UTF-8 flag"> below.
|
||||
|
||||
encode($valid_encoding, undef) is harmless but warns you for
|
||||
C<Use of uninitialized value in subroutine entry>.
|
||||
encode($valid_encoding, '') is harmless and warnless.
|
||||
|
||||
=item $string = decode(ENCODING, $octets [, CHECK])
|
||||
|
||||
Decodes a sequence of octets assumed to be in I<ENCODING> into Perl's
|
||||
@ -384,6 +383,10 @@ the utf8 flag for $string is on unless $octets entirely consists of
|
||||
ASCII data (or EBCDIC on EBCDIC machines). See L</"The UTF-8 flag">
|
||||
below.
|
||||
|
||||
decode($valid_encoding, undef) is harmless but warns you for
|
||||
C<Use of uninitialized value in subroutine entry>.
|
||||
decode($valid_encoding, '') is harmless and warnless.
|
||||
|
||||
=item [$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK])
|
||||
|
||||
Converts B<in-place> data between two encodings. The data in $octets
|
||||
@ -586,7 +589,7 @@ constants via C<use Encode qw(:fallback_all)>.
|
||||
|
||||
FB_DEFAULT FB_CROAK FB_QUIET FB_WARN FB_PERLQQ
|
||||
DIE_ON_ERR 0x0001 X
|
||||
WARN_ON_ER 0x0002 X
|
||||
WARN_ON_ERR 0x0002 X
|
||||
RETURN_ON_ERR 0x0004 X X
|
||||
LEAVE_SRC 0x0008
|
||||
PERLQQ 0x0100 X
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
/*
|
||||
$Id: Encode.xs,v 1.42 2002/04/29 06:54:06 dankogai Exp $
|
||||
$Id: Encode.xs,v 1.43 2002/05/01 05:41:06 dankogai Exp dankogai $
|
||||
*/
|
||||
|
||||
#define PERL_NO_GET_CONTEXT
|
||||
@ -130,72 +130,73 @@ encode_method(pTHX_ encode_t * enc, encpage_t * dir, SV * src,
|
||||
&clen, UTF8_ALLOW_ANY|UTF8_CHECK_ONLY);
|
||||
if (check & ENCODE_DIE_ON_ERR) {
|
||||
Perl_croak(
|
||||
aTHX_ "\"\\N{U+%" UVxf "}\" does not map to %s, %d",
|
||||
ch, enc->name[0], __LINE__);
|
||||
}else{
|
||||
if (check & ENCODE_RETURN_ON_ERR){
|
||||
if (check & ENCODE_WARN_ON_ERR){
|
||||
Perl_warner(
|
||||
aTHX_ packWARN(WARN_UTF8),
|
||||
aTHX_ "\"\\N{U+%" UVxf "}\" does not map to %s",
|
||||
(UV)ch, enc->name[0]);
|
||||
return &PL_sv_undef; /* never reaches but be safe */
|
||||
}
|
||||
if (check & ENCODE_WARN_ON_ERR){
|
||||
Perl_warner(aTHX_ packWARN(WARN_UTF8),
|
||||
"\"\\N{U+%" UVxf "}\" does not map to %s",
|
||||
ch,enc->name[0]);
|
||||
}
|
||||
goto ENCODE_SET_SRC;
|
||||
}else if (check & ENCODE_PERLQQ){
|
||||
SV* perlqq =
|
||||
sv_2mortal(newSVpvf("\\x{%04"UVxf"}", ch));
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + SvCUR(perlqq);
|
||||
sv_catsv(dst, perlqq);
|
||||
}else if (check & ENCODE_HTMLCREF){
|
||||
SV* htmlcref =
|
||||
sv_2mortal(newSVpvf("&#%" UVuf ";", ch));
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + SvCUR(htmlcref);
|
||||
sv_catsv(dst, htmlcref);
|
||||
}else if (check & ENCODE_XMLCREF){
|
||||
SV* xmlcref =
|
||||
sv_2mortal(newSVpvf("&#x%" UVxf ";", ch));
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + SvCUR(xmlcref);
|
||||
sv_catsv(dst, xmlcref);
|
||||
} else {
|
||||
/* fallback char */
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + enc->replen;
|
||||
sv_catpvn(dst, (char*)enc->rep, enc->replen);
|
||||
}
|
||||
(UV)ch, enc->name[0]);
|
||||
}
|
||||
if (check & ENCODE_RETURN_ON_ERR){
|
||||
goto ENCODE_SET_SRC;
|
||||
}
|
||||
if (check & ENCODE_PERLQQ){
|
||||
SV* perlqq =
|
||||
sv_2mortal(newSVpvf("\\x{%04"UVxf"}", (UV)ch));
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + SvCUR(perlqq);
|
||||
sv_catsv(dst, perlqq);
|
||||
}else if (check & ENCODE_HTMLCREF){
|
||||
SV* htmlcref =
|
||||
sv_2mortal(newSVpvf("&#%" UVuf ";", (UV)ch));
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + SvCUR(htmlcref);
|
||||
sv_catsv(dst, htmlcref);
|
||||
}else if (check & ENCODE_XMLCREF){
|
||||
SV* xmlcref =
|
||||
sv_2mortal(newSVpvf("&#x%" UVxf ";", (UV)ch));
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + SvCUR(xmlcref);
|
||||
sv_catsv(dst, xmlcref);
|
||||
} else {
|
||||
/* fallback char */
|
||||
sdone += slen + clen;
|
||||
ddone += dlen + enc->replen;
|
||||
sv_catpvn(dst, (char*)enc->rep, enc->replen);
|
||||
}
|
||||
}
|
||||
/* decoding */
|
||||
else {
|
||||
if (check & ENCODE_DIE_ON_ERR){
|
||||
Perl_croak(
|
||||
aTHX_ "%s \"\\x%02" UVXf
|
||||
aTHX_ "%s \"\\x%02" UVXf
|
||||
"\" does not map to Unicode (%d)",
|
||||
enc->name[0], (U8) s[slen], code);
|
||||
}else{
|
||||
if (check & ENCODE_RETURN_ON_ERR){
|
||||
if (check & ENCODE_WARN_ON_ERR){
|
||||
Perl_warner(
|
||||
aTHX_ packWARN(WARN_UTF8),
|
||||
"%s \"\\x%02" UVXf
|
||||
"\" does not map to Unicode (%d)",
|
||||
enc->name[0], (U8) s[slen], code);
|
||||
}
|
||||
goto ENCODE_SET_SRC;
|
||||
}else if (check &
|
||||
(ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
|
||||
SV* perlqq =
|
||||
sv_2mortal(newSVpvf("\\x%02" UVXf, s[slen]));
|
||||
sdone += slen + 1;
|
||||
ddone += dlen + SvCUR(perlqq);
|
||||
sv_catsv(dst, perlqq);
|
||||
} else {
|
||||
sdone += slen + 1;
|
||||
ddone += dlen + strlen(FBCHAR_UTF8);
|
||||
sv_catpv(dst, FBCHAR_UTF8);
|
||||
}
|
||||
(UV)enc->name[0], (U8)s[slen], code);
|
||||
return &PL_sv_undef; /* never reaches but be safe */
|
||||
}
|
||||
if (check & ENCODE_WARN_ON_ERR){
|
||||
Perl_warner(
|
||||
aTHX_ packWARN(WARN_UTF8),
|
||||
"%s \"\\x%02" UVXf
|
||||
"\" does not map to Unicode (%d)",
|
||||
(UV)enc->name[0], (U8)s[slen], code);
|
||||
}
|
||||
if (check & ENCODE_RETURN_ON_ERR){
|
||||
goto ENCODE_SET_SRC;
|
||||
}
|
||||
if (check &
|
||||
(ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
|
||||
SV* perlqq =
|
||||
sv_2mortal(newSVpvf("\\x%02" UVXf, (UV)s[slen]));
|
||||
sdone += slen + 1;
|
||||
ddone += dlen + SvCUR(perlqq);
|
||||
sv_catsv(dst, perlqq);
|
||||
} else {
|
||||
sdone += slen + 1;
|
||||
ddone += dlen + strlen(FBCHAR_UTF8);
|
||||
sv_catpv(dst, FBCHAR_UTF8);
|
||||
}
|
||||
}
|
||||
/* settle variables when fallback */
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/perl
|
||||
# $Id: ucm2table,v 1.2 2002/04/30 16:13:37 dankogai Exp dankogai $
|
||||
# $Id: ucm2table,v 1.2 2002/04/30 16:13:37 dankogai Exp $
|
||||
#
|
||||
|
||||
use 5.006;
|
||||
|
||||
@ -13,10 +13,9 @@ BEGIN {
|
||||
|
||||
use strict;
|
||||
#use Test::More qw(no_plan);
|
||||
use Test::More tests => 19;
|
||||
use Test::More tests => 22;
|
||||
use Encode q(:all);
|
||||
|
||||
|
||||
my $original = '';
|
||||
my $nofallback = '';
|
||||
my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref);
|
||||
@ -72,6 +71,15 @@ is($src, $residue, "FB_QUIET residue");
|
||||
is($dst, $quiet, "FB_WARN");
|
||||
is($src, $residue, "FB_WARN residue");
|
||||
like($message, qr/does not map to ascii/o, "FB_WARN message");
|
||||
|
||||
$message = '';
|
||||
|
||||
$src = $original;
|
||||
$dst = $meth->encode($src, WARN_ON_ERR);
|
||||
|
||||
is($dst, $fallenback, "WARN_ON_ERR");
|
||||
is($src, '', "WARN_ON_ERR residue");
|
||||
like($message, qr/does not map to ascii/o, "WARN_ON_ERR message");
|
||||
}
|
||||
|
||||
$src = $original;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user