From: Jarkko Hietaniemi Date: Wed, 1 May 2002 12:01:11 +0000 (+0000) Subject: Upgrade to Encode 1.66. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4089adc46e2b177bb3fcd7af1ecac309173adde4;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Encode 1.66. p4raw-id: //depot/perl@16300 --- diff --git a/ext/Encode/Changes b/ext/Encode/Changes index 595595e..a83e914 100644 --- a/ext/Encode/Changes +++ b/ext/Encode/Changes @@ -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. 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 diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index 4b0b1fe..80358ee 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -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 off. When you encode anything, utf8 flag of the result is always off, even when it contains completely valid utf8 string. See L below. +encode($valid_encoding, undef) is harmless but warns you for +C. +encode($valid_encoding, '') is harmless and warnless. + =item $string = decode(ENCODING, $octets [, CHECK]) Decodes a sequence of octets assumed to be in I 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 below. +decode($valid_encoding, undef) is harmless but warns you for +C. +decode($valid_encoding, '') is harmless and warnless. + =item [$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK]) Converts B data between two encodings. The data in $octets @@ -586,7 +589,7 @@ constants via C. 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 diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index ed67c10..17f746a 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -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 */ diff --git a/ext/Encode/bin/ucm2table b/ext/Encode/bin/ucm2table index 094ebe0..adcb9e8 100644 --- a/ext/Encode/bin/ucm2table +++ b/ext/Encode/bin/ucm2table @@ -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; diff --git a/ext/Encode/t/fallback.t b/ext/Encode/t/fallback.t index 3b66258..de7191f 100644 --- a/ext/Encode/t/fallback.t +++ b/ext/Encode/t/fallback.t @@ -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;