Change 16300 by jhi@alpha on 2002/05/01 12:01:11
Upgrade to Encode 1.66.
Affected files ...
.... //depot/perl/ext/Encode/Changes#32 edit
.... //depot/perl/ext/Encode/Encode.pm#109 edit
.... //depot/perl/ext/Encode/Encode.xs#83 edit
.... //depot/perl/ext/Encode/bin/ucm2table#4 edit
.... //depot/perl/ext/Encode/t/fallback.t#3 edit
Differences ...
==== //depot/perl/ext/Encode/Changes#32 (text) ====
Index: perl/ext/Encode/Changes
--- perl/ext/Encode/Changes.~1~ Wed May 1 06:15:05 2002
+++ perl/ext/Encode/Changes Wed May 1 06:15:05 2002
@@ -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: <[EMAIL PROTECTED]>
+
+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 @@
Typo fixes and improvements by jhi
Message-Id: <[EMAIL PROTECTED]>, 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
==== //depot/perl/ext/Encode/Encode.pm#109 (text) ====
Index: perl/ext/Encode/Encode.pm
--- perl/ext/Encode/Encode.pm.~1~ Wed May 1 06:15:05 2002
+++ perl/ext/Encode/Encode.pm Wed May 1 06:15:05 2002
@@ -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 encode($$;$)
{
my ($name, $string, $check) = @_;
- defined $string or return;
$check ||=0;
my $enc = find_encoding($name);
unless(defined $enc){
@@ -146,7 +145,6 @@
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 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 encode_utf8($)
{
my ($str) = @_;
- defined $str or return;
utf8::encode($str);
return $str;
}
@@ -191,7 +187,6 @@
sub decode_utf8($)
{
my ($str) = @_;
- defined $str or return;
return undef unless utf8::decode($str);
return $str;
}
@@ -366,6 +361,10 @@
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 @@
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 @@
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
==== //depot/perl/ext/Encode/Encode.xs#83 (text) ====
Index: perl/ext/Encode/Encode.xs
--- perl/ext/Encode/Encode.xs.~1~ Wed May 1 06:15:05 2002
+++ perl/ext/Encode/Encode.xs Wed May 1 06:15:05 2002
@@ -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 @@
&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)",
+ (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)",
- 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);
+ }
+ 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 */
==== //depot/perl/ext/Encode/bin/ucm2table#4 (text) ====
Index: perl/ext/Encode/bin/ucm2table
--- perl/ext/Encode/bin/ucm2table.~1~ Wed May 1 06:15:05 2002
+++ perl/ext/Encode/bin/ucm2table Wed May 1 06:15:05 2002
@@ -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;
==== //depot/perl/ext/Encode/t/fallback.t#3 (text) ====
Index: perl/ext/Encode/t/fallback.t
--- perl/ext/Encode/t/fallback.t.~1~ Wed May 1 06:15:05 2002
+++ perl/ext/Encode/t/fallback.t Wed May 1 06:15:05 2002
@@ -13,10 +13,9 @@
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($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;
End of Patch.
