In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a9cb10c376533cb82419abb1088d64b7d1f3cdb2?hp=5cd8b2253cf1f6f21dce7c3402b05c886f4da099>
- Log ----------------------------------------------------------------- commit a9cb10c376533cb82419abb1088d64b7d1f3cdb2 Merge: 5cd8b22 c312496 Author: Father Chrysostomos <[email protected]> Date: Wed Jul 13 01:12:58 2016 -0700 [Merge] Remove ${^ENCODING} functionality ⢠encoding::warnings is now a no-op that gives a warning. ⢠âuse encodingâ now dies, unless you specify a Filter argument. ⢠The ${^ENCODING} and ${^E_NCODING} variables and all the code they affected have been removed. commit c3124964282b6d735568bc4b405dca97c6e1f829 Author: Father Chrysostomos <[email protected]> Date: Mon Jul 11 17:46:27 2016 -0700 concat2.t: Remove encoding test Its purpose was to test the interaction between . and encoding.pm causing the stack to be reallocated. Since encoding.pm is disabled in 5.25.3 and above, the test is no longer necessary. M t/op/concat2.t commit 025072412ef40e8273e89112833a90d7ff04a31b Author: Father Chrysostomos <[email protected]> Date: Mon Jul 11 08:39:46 2016 -0700 Remove t/uni/tr_?jis.t I disabled them a few commits ago, thinking that maybe reworking them to test yâs utf8 support might be a good idea; but they duplicate tests already in t/uni/tr_utf8.t, so they are no longer necessary. M MANIFEST D t/uni/tr_7jis.t D t/uni/tr_sjis.t commit 98bf0eee484b2b458b845fd27e3f530373d1b930 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 10 22:07:27 2016 -0700 Increase $encoding::VERSION to 2.17_01 M cpan/Encode/encoding.pm commit 78eb0642bb889a7d8b13b49c16166cd9df6bbe48 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 10 21:42:43 2016 -0700 Update t/porting/customized.dat M t/porting/customized.dat commit c5a6fcde9e935abf29a128e33f134e0272a6f740 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 10 18:53:05 2016 -0700 Remove t/uni/chr.t Without âuse encodingâ, tests like ok(chr(0x7f) eq "\x7f"); have little to do with perlâs Unicode support, and they duplicate tests in t/op/chr.t. It is not necessary to convert these to use chars > 0xff, to test chr with Unicode, as t/op/chr.t already does that, too. Move the warning test to t/lib/warnings/pp. That is the only thing tested here that is not tested elsewhere. M MANIFEST M t/lib/warnings/pp D t/uni/chr.t commit 370579b70296bb5a423996c84702c6fc4a473f4a Author: Father Chrysostomos <[email protected]> Date: Sun Jul 10 13:01:05 2016 -0700 Disable encoding.pmâs default mode; update docs Its default mode became a no-op in recent commits, because ${^ENCODING} stopped doing anything. Also, fix/delete/skip tests that fail as a result. M MANIFEST M cpan/Encode/encoding.pm M cpan/Encode/t/enc_eucjp.t M cpan/Encode/t/enc_utf8.t M t/op/concat2.t M t/uni/chr.t D t/uni/tr_eucjp.t commit 92881630ff6dcc5a9e9d81b401608c569c3e67b7 Author: Father Chrysostomos <[email protected]> Date: Sun May 22 14:37:43 2016 -0700 Remove mg.c:_get_encoding Nothing uses it now, and it does nothing. M embed.fnc M embed.h M mg.c M proto.h commit 3a69dad21b36726c1abaee5f4bc07deb88e8bbb3 Author: Father Chrysostomos <[email protected]> Date: Sun May 22 14:35:31 2016 -0700 Remove PL_(lex_)encoding and all dependent code M embedvar.h M intrpvar.h M mg.c commit 8df0e7a28b22521824d9a5d0d44f2b27d2955298 Author: Father Chrysostomos <[email protected]> Date: Sun May 22 14:32:40 2016 -0700 Remove IN_ENCODING macro, and all code dependent on it M embed.fnc M embed.h M perl.h M pp.c M pp_hot.c M proto.h M regcomp.c M sv.c M toke.c commit a15a3d9b600adf7d9dd78193d608361f302b0370 Author: Father Chrysostomos <[email protected]> Date: Sat May 21 12:22:33 2016 -0700 Disable ${^ENCODING} ${^ENCODING} is disabled and tests are modified to account. M cpan/Encode/t/enc_data.t M cpan/Encode/t/enc_module.t M cpan/Encode/t/encoding.t M cpan/Encode/t/jperl.t M gv.c M mg.c M pod/perldiag.pod M t/lib/warnings/gv M t/lib/warnings/mg M t/op/concat2.t M t/op/magic.t M t/uni/chomp.t M t/uni/greek.t M t/uni/latin2.t M t/uni/tr_7jis.t M t/uni/tr_sjis.t M t/uni/tr_utf8.t commit 1a53cdb5c0a2c7f6b92ecb87480a4448bb6022c0 Author: Father Chrysostomos <[email protected]> Date: Sun May 22 13:51:58 2016 -0700 Increase $encoding::warnings::VERSION to 0.13 M dist/encoding-warnings/lib/encoding/warnings.pm commit b907137092fee3543ab991649fc6a69d6c97f964 Author: Father Chrysostomos <[email protected]> Date: Sun May 22 13:51:14 2016 -0700 Make encoding::warnings a no-op in 5.26 with a single warning at import time. M dist/encoding-warnings/lib/encoding/warnings.pm M dist/encoding-warnings/t/1-warning.t M dist/encoding-warnings/t/2-fatal.t M dist/encoding-warnings/t/3-normal.t M dist/encoding-warnings/t/4-lexical.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 4 - cpan/Encode/encoding.pm | 24 +++- cpan/Encode/t/enc_data.t | 4 + cpan/Encode/t/enc_eucjp.t | 4 + cpan/Encode/t/enc_module.t | 4 + cpan/Encode/t/enc_utf8.t | 4 + cpan/Encode/t/encoding.t | 4 + cpan/Encode/t/jperl.t | 4 + dist/encoding-warnings/lib/encoding/warnings.pm | 30 ++++- dist/encoding-warnings/t/1-warning.t | 20 +++- dist/encoding-warnings/t/2-fatal.t | 4 + dist/encoding-warnings/t/3-normal.t | 7 ++ dist/encoding-warnings/t/4-lexical.t | 4 + embed.fnc | 2 - embed.h | 2 - embedvar.h | 2 - gv.c | 3 - intrpvar.h | 3 - mg.c | 76 +----------- perl.h | 4 - pod/perldiag.pod | 5 + pp.c | 50 +------- pp_hot.c | 13 +-- proto.h | 6 - regcomp.c | 73 ------------ sv.c | 53 +-------- t/lib/warnings/gv | 10 ++ t/lib/warnings/mg | 4 +- t/lib/warnings/pp | 10 ++ t/op/concat2.t | 14 +-- t/op/magic.t | 13 ++- t/porting/customized.dat | 2 +- t/uni/chomp.t | 46 ++------ t/uni/chr.t | 33 ------ t/uni/greek.t | 4 +- t/uni/latin2.t | 4 +- t/uni/tr_7jis.t | 45 ------- t/uni/tr_eucjp.t | 44 ------- t/uni/tr_sjis.t | 44 ------- t/uni/tr_utf8.t | 6 +- toke.c | 149 +----------------------- 41 files changed, 169 insertions(+), 668 deletions(-) delete mode 100644 t/uni/chr.t delete mode 100644 t/uni/tr_7jis.t delete mode 100644 t/uni/tr_eucjp.t delete mode 100644 t/uni/tr_sjis.t diff --git a/MANIFEST b/MANIFEST index 133c0fc..05933a9 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5717,7 +5717,6 @@ t/uni/cache.t See if Unicode swash caching works t/uni/caller.t See if Unicode doesn't get mangled in caller() t/uni/case.pl See if Unicode casing works t/uni/chomp.t See if Unicode chomp works -t/uni/chr.t See if Unicode chr works t/uni/class.t See if Unicode classes work (\p) t/uni/eval.t See if Unicode hints don't affect eval() t/uni/fold.t See if Unicode folding works @@ -5740,9 +5739,6 @@ t/uni/sprintf.t See if Unicode sprintf works t/uni/stash.t See if Unicode stashes work t/uni/tie.t See if Unicode tie works t/uni/title.t See if Unicode casing works -t/uni/tr_7jis.t See if Unicode tr/// in 7jis works -t/uni/tr_eucjp.t See if Unicode tr/// in eucjp works -t/uni/tr_sjis.t See if Unicode tr/// in sjis works t/uni/tr_utf8.t See if Unicode tr/// in utf8 works t/uni/universal.t See if Unicode in calls to UNIVERSAL works t/uni/upper.t See if Unicode casing works diff --git a/cpan/Encode/encoding.pm b/cpan/Encode/encoding.pm index 8450f9c..afdcfac 100644 --- a/cpan/Encode/encoding.pm +++ b/cpan/Encode/encoding.pm @@ -1,6 +1,6 @@ # $Id: encoding.pm,v 2.17 2015/09/15 13:53:27 dankogai Exp dankogai $ package encoding; -our $VERSION = sprintf "%d.%02d", q$Revision: 2.17 $ =~ /(\d+)/g; +our $VERSION = '2.17_01'; use Encode; use strict; @@ -114,10 +114,9 @@ sub import { Carp::croak("encoding: pragma does not support EBCDIC platforms"); } - if ($] >= 5.017) { - warnings::warnif("deprecated", - "Use of the encoding pragma is deprecated") - } + my $deprecate = + $] >= 5.017 ? "Use of the encoding pragma is deprecated" : 0; + my $class = shift; my $name = shift; if (!$name){ @@ -142,6 +141,12 @@ sub import { } $name = $enc->name; # canonize unless ( $arg{Filter} ) { + if ($] >= 5.025003) { + require Carp; + Carp::croak("The encoding pragma is no longer supported"); + } + warnings::warnif("deprecated",$deprecate) if $deprecate; + DEBUG and warn "_exception($name) = ", _exception($name); if (! _exception($name)) { if (!PERL_5_21_7) { @@ -158,6 +163,8 @@ sub import { HAS_PERLIO or return 1; } else { + warnings::warnif("deprecate",$deprecate) if $deprecate; + defined( ${^ENCODING} ) and undef ${^ENCODING}; undef ${^E_NCODING} if PERL_5_21_7; @@ -280,6 +287,10 @@ Old code should be converted to UTF-8, via something like the recipe in the L</SYNOPSIS> (though this simple approach may require manual adjustments afterwards). +If UTF-8 is not an option, it is recommended that one use a simple source +filter, such as that provided by L<Filter::Encoding> on CPAN or this +pragma's own C<Filter> option (see below). + The only legitimate use of this pragma is almost certainly just one per file, near the top, with file scope, as the file is likely going to only be written in one encoding. Further restrictions apply in Perls before v5.22 (see @@ -291,6 +302,9 @@ There are two basic modes of operation (plus turning if off): =item C<use encoding ['I<ENCNAME>'] ;> +Please note: This mode of operation is not longer supported as of Perl +v5.26. + This is the normal operation. It translates various literals encountered in the Perl source file from the encoding I<ENCNAME> into UTF-8, and similarly converts character code points. This is used when the script is a combination diff --git a/cpan/Encode/t/enc_data.t b/cpan/Encode/t/enc_data.t index a0caf65..b401595 100644 --- a/cpan/Encode/t/enc_data.t +++ b/cpan/Encode/t/enc_data.t @@ -14,6 +14,10 @@ BEGIN { print "1..0 # encoding pragma does not support EBCDIC platforms\n"; exit(0); } + if ("$]" >= 5.025) { + print "1..0 # encoding pragma not supported in Perl 5.26\n"; + exit(0); + } if ($] <= 5.008 and !$Config{perl_patchlevel}){ print "1..0 # Skip: Perl 5.8.1 or later required\n"; exit 0; diff --git a/cpan/Encode/t/enc_eucjp.t b/cpan/Encode/t/enc_eucjp.t index 7c78a68..37fccba 100644 --- a/cpan/Encode/t/enc_eucjp.t +++ b/cpan/Encode/t/enc_eucjp.t @@ -19,6 +19,10 @@ BEGIN { print "1..0 # Skip: Perl 5.8.1 or later required\n"; exit 0; } + if ($] >= 5.025003){ + print "1..0 # Skip: Perl 5.25.2 or lower required\n"; + exit 0; + } } no warnings "deprecated"; diff --git a/cpan/Encode/t/enc_module.t b/cpan/Encode/t/enc_module.t index 05fc6c2..3004ed2 100644 --- a/cpan/Encode/t/enc_module.t +++ b/cpan/Encode/t/enc_module.t @@ -18,6 +18,10 @@ BEGIN { print "1..0 # encoding pragma does not support EBCDIC platforms\n"; exit(0); } + if ("$]" >= 5.025) { + print "1..0 # encoding pragma not supported in Perl 5.26\n"; + exit(0); + } } use lib qw(t ext/Encode/t ../ext/Encode/t); # latter 2 for perl core use Mod_EUCJP; diff --git a/cpan/Encode/t/enc_utf8.t b/cpan/Encode/t/enc_utf8.t index 9c6caa3..047452f 100644 --- a/cpan/Encode/t/enc_utf8.t +++ b/cpan/Encode/t/enc_utf8.t @@ -15,6 +15,10 @@ BEGIN { print "1..0 # encoding pragma does not support EBCDIC platforms\n"; exit(0); } + if ($] >= 5.025003){ + print "1..0 # Skip: Perl 5.25.2 or lower required\n"; + exit 0; + } } no warnings "deprecated"; diff --git a/cpan/Encode/t/encoding.t b/cpan/Encode/t/encoding.t index 21f9e47..18d1921 100644 --- a/cpan/Encode/t/encoding.t +++ b/cpan/Encode/t/encoding.t @@ -12,6 +12,10 @@ BEGIN { print "1..0 # encoding pragma does not support EBCDIC platforms\n"; exit(0); } + if ("$]" >= 5.025) { + print "1..0 # encoding pragma not supported in Perl 5.26\n"; + exit(0); + } } print "1..33\n"; diff --git a/cpan/Encode/t/jperl.t b/cpan/Encode/t/jperl.t index 3abe86b..5f437ff 100644 --- a/cpan/Encode/t/jperl.t +++ b/cpan/Encode/t/jperl.t @@ -17,6 +17,10 @@ BEGIN { print "1..0 # Skip: EBCDIC\n"; exit 0; } + if ("$]" >= 5.025) { + print "1..0 # encoding pragma not supported in Perl 5.26\n"; + exit(0); + } $| = 1; } diff --git a/dist/encoding-warnings/lib/encoding/warnings.pm b/dist/encoding-warnings/lib/encoding/warnings.pm index d5c4184..d75277e 100644 --- a/dist/encoding-warnings/lib/encoding/warnings.pm +++ b/dist/encoding-warnings/lib/encoding/warnings.pm @@ -1,5 +1,5 @@ package encoding::warnings; -$encoding::warnings::VERSION = '0.12'; +$encoding::warnings::VERSION = '0.13'; use strict; use 5.007; @@ -10,8 +10,22 @@ encoding::warnings - Warn on implicit encoding conversions =head1 VERSION -This document describes version 0.11 of encoding::warnings, released -June 5, 2007. +This document describes version 0.13 of encoding::warnings, released +June 20, 2016. + +=head1 NOTICE + +As of Perl 5.26.0, this module has no effect. The internal Perl feature +that was used to implement this module has been removed. In recent years, +much work has been done on the Perl core to eliminate discrepancies in the +treatment of upgraded versus downgraded strings. In addition, the +L<encoding> pragma, which caused many of the problems, is no longer +supported. Thus, the warnings this module produced are no longer +necessary. + +Hence, if you load this module on Perl 5.26.0, you will get one warning +that the module is no longer supported; and the module will do nothing +thereafter. =head1 SYNOPSIS @@ -146,8 +160,16 @@ sub ASCII () { 0 } sub LATIN1 () { 1 } sub FATAL () { 2 } -# Install a ${^ENCODING} handler if no other one are already in place. sub import { + if ($] >= 5.025003) { + require Carp; + Carp::cluck( + "encoding::warnings is not supported on Perl 5.26.0 and later" + ); + return; + } + + # Install a ${^ENCODING} handler if no other one are already in place. my $class = shift; my $fatal = shift || ''; diff --git a/dist/encoding-warnings/t/1-warning.t b/dist/encoding-warnings/t/1-warning.t index 9b04cb6..fa0bb6e 100644 --- a/dist/encoding-warnings/t/1-warning.t +++ b/dist/encoding-warnings/t/1-warning.t @@ -14,9 +14,25 @@ BEGIN { } use Test; -BEGIN { plan tests => 2 } - use strict; + +BEGIN { + if ("$]" >= 5.025) { + # Test the new almost-noop behaviour in new perls. + plan tests => 3; + my $w; + $SIG{__WARN__} = sub { $w .= shift }; + require encoding::warnings; + ok $w, undef, 'no warning from requiring encoding::warnings'; + ok(encoding::warnings->VERSION); + encoding::warnings->import; + ok $w, qr/^encoding::warnings is not supported /, 'import warning'; + exit; + } + # else continue with your usual scheduled testing... + plan tests => 2; +} + use encoding::warnings; ok(encoding::warnings->VERSION); diff --git a/dist/encoding-warnings/t/2-fatal.t b/dist/encoding-warnings/t/2-fatal.t index ef00181..d2928cd 100644 --- a/dist/encoding-warnings/t/2-fatal.t +++ b/dist/encoding-warnings/t/2-fatal.t @@ -3,6 +3,10 @@ # $Revision: #4 $ $Change: 1626 $ $DateTime: 2004-03-14T16:53:19.351256Z $ BEGIN { + if ("$]" >= 5.025) { + print "1..0 # Skip: encoding::warnings not supported on perl 5.26\n"; + exit 0; + } if (ord("A") != 65) { print "1..0 # Skip: Encode not working on EBCDIC\n"; exit 0; diff --git a/dist/encoding-warnings/t/3-normal.t b/dist/encoding-warnings/t/3-normal.t index f0e6446..a66798b 100644 --- a/dist/encoding-warnings/t/3-normal.t +++ b/dist/encoding-warnings/t/3-normal.t @@ -1,3 +1,10 @@ +BEGIN { + if ("$]" >= 5.025) { + print "1..0 # Skip: encoding::warnings not supported on perl 5.26\n"; + exit 0; + } +} + use Test; BEGIN { plan tests => 2 } diff --git a/dist/encoding-warnings/t/4-lexical.t b/dist/encoding-warnings/t/4-lexical.t index bdd9f21..0f6b4c1 100644 --- a/dist/encoding-warnings/t/4-lexical.t +++ b/dist/encoding-warnings/t/4-lexical.t @@ -1,6 +1,10 @@ use strict; use Test; BEGIN { + if ("$]" >= 5.025) { + print "1..0 # Skip: encoding::warnings not supported on perl 5.26\n"; + exit 0; + } if (ord("A") != 65) { print "1..0 # Skip: Encode not working on EBCDIC\n"; exit 0; diff --git a/embed.fnc b/embed.fnc index 88a70f9..9b3a28b 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2195,7 +2195,6 @@ Es |regnode*|handle_regex_sets|NN RExC_state_t *pRExC_state \ |NN char * const oregcomp_parse Es |void|parse_lparen_question_flags|NN RExC_state_t *pRExC_state Es |regnode*|reg_node |NN RExC_state_t *pRExC_state|U8 op -Es |UV |reg_recode |const U8 value|NN SV **encp Es |regnode*|regpiece |NN RExC_state_t *pRExC_state \ |NN I32 *flagp|U32 depth Es |bool |grok_bslash_N |NN RExC_state_t *pRExC_state \ @@ -2946,7 +2945,6 @@ Ei |STRLEN |sv_or_pv_pos_u2b|NN SV *sv|NN const char *pv|STRLEN pos \ |NULLOK STRLEN *lenp #endif -EMpPX |SV* |_get_encoding Ap |void |clear_defarray |NN AV* av|bool abandon ApM |void |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \ diff --git a/embed.h b/embed.h index de5a590..a666cd3 100644 --- a/embed.h +++ b/embed.h @@ -931,7 +931,6 @@ #define do_spawn_nowait(a) Perl_do_spawn_nowait(aTHX_ a) #endif #if defined(PERL_CORE) || defined(PERL_EXT) -#define _get_encoding() Perl__get_encoding(aTHX) #define _warn_problematic_locale Perl__warn_problematic_locale #define av_reify(a) Perl_av_reify(aTHX_ a) #define current_re_engine() Perl_current_re_engine(aTHX) @@ -1037,7 +1036,6 @@ #define reg(a,b,c,d) S_reg(aTHX_ a,b,c,d) #define reg2Lanode(a,b,c,d) S_reg2Lanode(aTHX_ a,b,c,d) #define reg_node(a,b) S_reg_node(aTHX_ a,b) -#define reg_recode(a,b) S_reg_recode(aTHX_ a,b) #define reg_scan_name(a,b) S_reg_scan_name(aTHX_ a,b) #define reg_skipcomment S_reg_skipcomment #define reganode(a,b,c) S_reganode(aTHX_ a,b,c) diff --git a/embedvar.h b/embedvar.h index c2831d6..ec0b7b1 100644 --- a/embedvar.h +++ b/embedvar.h @@ -140,7 +140,6 @@ #define PL_e_script (vTHX->Ie_script) #define PL_efloatbuf (vTHX->Iefloatbuf) #define PL_efloatsize (vTHX->Iefloatsize) -#define PL_encoding (vTHX->Iencoding) #define PL_endav (vTHX->Iendav) #define PL_envgv (vTHX->Ienvgv) #define PL_errgv (vTHX->Ierrgv) @@ -185,7 +184,6 @@ #define PL_lastgotoprobe (vTHX->Ilastgotoprobe) #define PL_laststatval (vTHX->Ilaststatval) #define PL_laststype (vTHX->Ilaststype) -#define PL_lex_encoding (vTHX->Ilex_encoding) #define PL_localizing (vTHX->Ilocalizing) #define PL_localpatches (vTHX->Ilocalpatches) #define PL_lockhook (vTHX->Ilockhook) diff --git a/gv.c b/gv.c index dff611e..4d5a071 100644 --- a/gv.c +++ b/gv.c @@ -1921,9 +1921,6 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, goto magicalize; break; case '\005': /* $^ENCODING */ - if (*name2 == '_') { - name2++; - } if (strEQ(name2, "NCODING")) goto magicalize; break; diff --git a/intrpvar.h b/intrpvar.h index ca1bb71..756b1dc 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -695,9 +695,6 @@ PERLVARI(I, known_layers, PerlIO_list_t *, NULL) PERLVARI(I, def_layerlist, PerlIO_list_t *, NULL) #endif -PERLVARI(I, encoding, SV *, NULL) /* $^ENCODING */ -PERLVARI(I, lex_encoding, SV *, NULL) /* encoding pragma */ - PERLVAR(I, utf8_idstart, SV *) PERLVAR(I, utf8_idcont, SV *) PERLVAR(I, utf8_xidstart, SV *) diff --git a/mg.c b/mg.c index 4321a40..0a93cb8 100644 --- a/mg.c +++ b/mg.c @@ -766,46 +766,6 @@ S_fixup_errno_string(pTHX_ SV* sv) } } -SV* -Perl__get_encoding(pTHX) -{ - /* For core Perl use only: Returns the $^ENCODING or 'use encoding' in - * effect; NULL if none. - * - * $^ENCODING maps to PL_encoding, and is the old way to do things, and is - * retained for backwards compatibility. Now, there is a shadow variable - * ${^E_NCODING} set only by the encoding pragma, used to give this pragma - * lexical scope, unlike the global scope it (shudder) used to have. This - * variable maps to PL_lex_encoding. Again for backwards compatibility, - * PL_encoding has precedence over PL_lex_encoding. The hints hash is used - * to determine if PL_lex_encoding is in scope, and hence valid. The hints - * hash only accepts simple values, so we can't put an Encode object into - * it, so we put the object into the global, and put a simple boolean into - * the hints hash giving whether the global is valid or not */ - - dVAR; - SV *is_encoding; - - if (PL_encoding) { - return PL_encoding; - } - - if (! PL_lex_encoding) { - return NULL; - } - - is_encoding = cop_hints_fetch_pvs(PL_curcop, "encoding", 0); - if ( is_encoding - && is_encoding != &PL_sv_placeholder - && SvIOK(is_encoding) - && SvIV(is_encoding)) /* non-zero mean valid */ - { - return PL_lex_encoding; - } - - return NULL; -} - #ifdef VMS #include <descrip.h> #include <starlet.h> @@ -856,8 +816,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\005': /* ^E */ if (nextchar != '\0') { if (strEQ(remaining, "NCODING")) - sv_setsv(sv, _get_encoding()); - else if (strEQ(remaining, "_NCODING")) sv_setsv(sv, NULL); break; } @@ -2733,41 +2691,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif } else { - unsigned int offset = 1; - bool lex = FALSE; - - /* It may be the shadow variable ${E_NCODING} which has lexical - * scope. See comments at Perl__get_encoding in this file */ - if (*(mg->mg_ptr + 1) == '_') { - if (CopSTASH(PL_curcop) != get_hv("encoding::",0)) - Perl_croak_no_modify(); - lex = TRUE; - offset++; - } - if (strEQ(mg->mg_ptr + offset, "NCODING")) { - if (lex) { /* Use the shadow global */ - SvREFCNT_dec(PL_lex_encoding); - if (SvOK(sv) || SvGMAGICAL(sv)) { - PL_lex_encoding = newSVsv(sv); - } - else { - PL_lex_encoding = NULL; - } - } - else { /* Use the regular global */ - SvREFCNT_dec(PL_encoding); - if (SvOK(sv) || SvGMAGICAL(sv)) { + if (strEQ(mg->mg_ptr + 1, "NCODING") && SvOK(sv)) if (PL_localizing != 2) { Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "Setting ${^ENCODING} is deprecated"); + "${^ENCODING} is no longer supported"); } - PL_encoding = newSVsv(sv); - } - else { - PL_encoding = NULL; - } - } - } } break; case '\006': /* ^F */ diff --git a/perl.h b/perl.h index 6c001e0..1f19140 100644 --- a/perl.h +++ b/perl.h @@ -757,10 +757,6 @@ # endif #endif /* !NO_LOCALE && HAS_SETLOCALE */ -/* Is $^ENCODING set, or are we under the encoding pragma? */ -#define IN_ENCODING UNLIKELY(PL_encoding \ - || (PL_lex_encoding && _get_encoding() != NULL)) - #include <setjmp.h> #ifdef I_SYS_PARAM diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 4164baf..fb502bb 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2086,6 +2086,11 @@ unlikely to be what you want. described in L<perlunicode> and L<perlre>. You used C<\p> or C<\P> in a regular expression without specifying the property name. +=item ${^ENCODING} is no longer supported + +(D deprecated) The special variable C<${^ENCODING}>, formerly used to implement +the C<encoding> pragma, is no longer supported as of Perl 5.26.0. + =item entering effective %s failed (F) While under the C<use filetest> pragma, switching the real and diff --git a/pp.c b/pp.c index 3df0bea..4771134 100644 --- a/pp.c +++ b/pp.c @@ -809,17 +809,6 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping) Perl_croak_no_modify(); } - if (IN_ENCODING) { - if (!SvUTF8(sv)) { - /* XXX, here sv is utf8-ized as a side-effect! - If encoding.pm is used properly, almost string-generating - operations, including literal strings, chr(), input data, etc. - should have been utf8-ized already, right? - */ - sv_recode_to_utf8(sv, _get_encoding()); - } - } - s = SvPV(sv, len); if (chomping) { if (s && len) { @@ -861,14 +850,6 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping) } rsptr = temp_buffer; } - else if (IN_ENCODING) { - /* RS is 8 bit, encoding.pm is used. - * Do not recode PL_rs as a side-effect. */ - svrecode = newSVpvn(rsptr, rslen); - sv_recode_to_utf8(svrecode, _get_encoding()); - rsptr = SvPV_const(svrecode, rslen); - rs_charlen = sv_len_utf8(svrecode); - } else { /* RS is 8 bit, scalar is utf8. */ temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen); @@ -3544,7 +3525,7 @@ PP(pp_index) little_utf8 = DO_UTF8(little); if (big_utf8 ^ little_utf8) { /* One needs to be upgraded. */ - if (little_utf8 && !IN_ENCODING) { + if (little_utf8) { /* Well, maybe instead we might be able to downgrade the small string? */ char * const pv = (char*)bytes_from_utf8((U8 *)little_p, &llen, @@ -3566,11 +3547,7 @@ PP(pp_index) temp = little_utf8 ? newSVpvn(big_p, biglen) : newSVpvn(little_p, llen); - if (IN_ENCODING) { - sv_recode_to_utf8(temp, _get_encoding()); - } else { - sv_utf8_upgrade(temp); - } + sv_utf8_upgrade(temp); if (little_utf8) { big = temp; big_utf8 = TRUE; @@ -3652,13 +3629,6 @@ PP(pp_ord) STRLEN len; const U8 *s = (U8*)SvPV_const(argsv, len); - if (IN_ENCODING && SvPOK(argsv) && !DO_UTF8(argsv)) { - SV * const tmpsv = sv_2mortal(newSVsv(argsv)); - s = (U8*)sv_recode_to_utf8(tmpsv, _get_encoding()); - len = UTF8SKIP(s); /* Should be well-formed; so this is its length */ - argsv = tmpsv; - } - SETu(DO_UTF8(argsv) ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV) : (UV)(*s)); @@ -3720,22 +3690,6 @@ PP(pp_chr) *tmps = '\0'; (void)SvPOK_only(TARG); - if (IN_ENCODING && !IN_BYTES) { - sv_recode_to_utf8(TARG, _get_encoding()); - tmps = SvPVX(TARG); - if (SvCUR(TARG) == 0 - || ! is_utf8_string((U8*)tmps, SvCUR(TARG)) - || UTF8_IS_REPLACEMENT((U8*) tmps, (U8*) tmps + SvCUR(TARG))) - { - SvGROW(TARG, 2); - tmps = SvPVX(TARG); - SvCUR_set(TARG, 1); - *tmps++ = (char)value; - *tmps = '\0'; - SvUTF8_off(TARG); - } - } - SETTARG; return NORMAL; } diff --git a/pp_hot.c b/pp_hot.c index ca90c1e..8734687 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -3011,10 +3011,7 @@ PP(pp_subst) if (DO_UTF8(TARG) && !doutf8) { nsv = sv_newmortal(); SvSetSV(nsv, dstr); - if (IN_ENCODING) - sv_recode_to_utf8(nsv, _get_encoding()); - else - sv_utf8_upgrade(nsv); + sv_utf8_upgrade(nsv); c = SvPV_const(nsv, clen); doutf8 = TRUE; } @@ -3193,13 +3190,7 @@ PP(pp_subst) first = FALSE; } else { - if (IN_ENCODING) { - if (!nsv) nsv = sv_newmortal(); - sv_copypv(nsv, repl); - if (!DO_UTF8(nsv)) sv_recode_to_utf8(nsv, _get_encoding()); - sv_catsv(dstr, nsv); - } - else sv_catsv(dstr, repl); + sv_catsv(dstr, repl); if (UNLIKELY(SvTAINTED(repl))) rxtainted |= SUBST_TAINT_REPL; } diff --git a/proto.h b/proto.h index 5c8f9d8..2d12387 100644 --- a/proto.h +++ b/proto.h @@ -42,9 +42,6 @@ PERL_CALLCONV void* Perl_Slab_Alloc(pTHX_ size_t sz) PERL_CALLCONV void Perl_Slab_Free(pTHX_ void *op); #define PERL_ARGS_ASSERT_SLAB_FREE \ assert(op) -PERL_CALLCONV SV* Perl__get_encoding(pTHX) - __attribute__pure__; - PERL_CALLCONV bool Perl__is_in_locale_category(pTHX_ const bool compiling, const int category); PERL_CALLCONV bool Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c) __attribute__warn_unused_result__; @@ -4991,9 +4988,6 @@ STATIC regnode* S_reg2Lanode(pTHX_ RExC_state_t *pRExC_state, const U8 op, const STATIC regnode* S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op); #define PERL_ARGS_ASSERT_REG_NODE \ assert(pRExC_state) -STATIC UV S_reg_recode(pTHX_ const U8 value, SV **encp); -#define PERL_ARGS_ASSERT_REG_RECODE \ - assert(encp) STATIC SV * S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags); #define PERL_ARGS_ASSERT_REG_SCAN_NAME \ assert(pRExC_state) diff --git a/regcomp.c b/regcomp.c index 378ebc9..4592f49 100644 --- a/regcomp.c +++ b/regcomp.c @@ -11979,39 +11979,6 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, } -/* - * reg_recode - * - * It returns the code point in utf8 for the value in *encp. - * value: a code value in the source encoding - * encp: a pointer to an Encode object - * - * If the result from Encode is not a single character, - * it returns U+FFFD (Replacement character) and sets *encp to NULL. - */ -STATIC UV -S_reg_recode(pTHX_ const U8 value, SV **encp) -{ - STRLEN numlen = 1; - SV * const sv = newSVpvn_flags((const char *) &value, numlen, SVs_TEMP); - const char * const s = *encp ? sv_recode_to_utf8(sv, *encp) : SvPVX(sv); - const STRLEN newlen = SvCUR(sv); - UV uv = UNICODE_REPLACEMENT; - - PERL_ARGS_ASSERT_REG_RECODE; - - if (newlen) - uv = SvUTF8(sv) - ? utf8n_to_uvchr((U8*)s, newlen, &numlen, UTF8_ALLOW_DEFAULT) - : *(U8*)s; - - if (!newlen || numlen != newlen) { - uv = UNICODE_REPLACEMENT; - *encp = NULL; - } - return uv; -} - PERL_STATIC_INLINE U8 S_compute_EXACTish(RExC_state_t *pRExC_state) { @@ -13081,9 +13048,6 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) vFAIL(error_msg); } ender = result; - if (IN_ENCODING && ender < 0x100) { - goto recode_encoding; - } if (ender > 0xff) { REQUIRE_UTF8(flagp); } @@ -13116,11 +13080,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) if (RExC_recode_x_to_native) { ender = LATIN1_TO_NATIVE(ender); } - else #endif - if (IN_ENCODING) { - goto recode_encoding; - } } else { REQUIRE_UTF8(flagp); @@ -13180,17 +13140,6 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) form_short_octal_warning(p, numlen)); } } - if (IN_ENCODING && ender < 0x100) - goto recode_encoding; - break; - recode_encoding: - if (! RExC_override_recoding) { - SV* enc = _get_encoding(); - ender = reg_recode((U8)ender, &enc); - if (!enc && PASS2) - ckWARNreg(p, "Invalid escape in the specified encoding"); - REQUIRE_UTF8(flagp); - } break; case '\0': if (p >= RExC_end) @@ -16165,9 +16114,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } } non_portable_endpoint++; - if (IN_ENCODING && value < 0x100) { - goto recode_encoding; - } break; case 'x': RExC_parse--; /* function expects to be pointed at the 'x' */ @@ -16185,8 +16131,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } } non_portable_endpoint++; - if (IN_ENCODING && value < 0x100) - goto recode_encoding; break; case 'c': value = grok_bslash_c(*RExC_parse++, PASS2); @@ -16219,23 +16163,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } } non_portable_endpoint++; - if (IN_ENCODING && value < 0x100) - goto recode_encoding; - break; - } - recode_encoding: - if (! RExC_override_recoding) { - SV* enc = _get_encoding(); - value = reg_recode((U8)value, &enc); - if (!enc) { - if (strict) { - vFAIL("Invalid escape in the specified encoding"); - } - else if (PASS2) { - ckWARNreg(RExC_parse, - "Invalid escape in the specified encoding"); - } - } break; } default: diff --git a/sv.c b/sv.c index 0cbe371..0cd0f6b 100644 --- a/sv.c +++ b/sv.c @@ -3456,12 +3456,6 @@ Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extr S_sv_uncow(aTHX_ sv, 0); } - if (IN_ENCODING && !(flags & SV_UTF8_NO_ENCODING)) { - sv_recode_to_utf8(sv, _get_encoding()); - if (extra) SvGROW(sv, SvCUR(sv) + extra); - return SvCUR(sv); - } - if (SvCUR(sv) == 0) { if (extra) SvGROW(sv, extra); } else { /* Assume Latin-1/EBCDIC */ @@ -7757,37 +7751,17 @@ Perl_sv_eq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags) pv2 = SvPV_flags_const(sv2, cur2, flags); if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) { - /* Differing utf8ness. - * Do not UTF8size the comparands as a side-effect. */ - if (IN_ENCODING) { - if (SvUTF8(sv1)) { - svrecode = newSVpvn(pv2, cur2); - sv_recode_to_utf8(svrecode, _get_encoding()); - pv2 = SvPV_const(svrecode, cur2); - } - else { - svrecode = newSVpvn(pv1, cur1); - sv_recode_to_utf8(svrecode, _get_encoding()); - pv1 = SvPV_const(svrecode, cur1); - } - /* Now both are in UTF-8. */ - if (cur1 != cur2) { - SvREFCNT_dec_NN(svrecode); - return FALSE; - } - } - else { - if (SvUTF8(sv1)) { + /* Differing utf8ness. */ + if (SvUTF8(sv1)) { /* sv1 is the UTF-8 one */ return bytes_cmp_utf8((const U8*)pv2, cur2, (const U8*)pv1, cur1) == 0; - } - else { + } + else { /* sv2 is the UTF-8 one */ return bytes_cmp_utf8((const U8*)pv1, cur1, (const U8*)pv2, cur2) == 0; - } - } + } } if (cur1 == cur2) @@ -7847,31 +7821,16 @@ Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2, pv2 = SvPV_flags_const(sv2, cur2, flags); if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) { - /* Differing utf8ness. - * Do not UTF8size the comparands as a side-effect. */ + /* Differing utf8ness. */ if (SvUTF8(sv1)) { - if (IN_ENCODING) { - svrecode = newSVpvn(pv2, cur2); - sv_recode_to_utf8(svrecode, _get_encoding()); - pv2 = SvPV_const(svrecode, cur2); - } - else { const int retval = -bytes_cmp_utf8((const U8*)pv2, cur2, (const U8*)pv1, cur1); return retval ? retval < 0 ? -1 : +1 : 0; - } } else { - if (IN_ENCODING) { - svrecode = newSVpvn(pv1, cur1); - sv_recode_to_utf8(svrecode, _get_encoding()); - pv1 = SvPV_const(svrecode, cur1); - } - else { const int retval = bytes_cmp_utf8((const U8*)pv1, cur1, (const U8*)pv2, cur2); return retval ? retval < 0 ? -1 : +1 : 0; - } } } diff --git a/t/lib/warnings/gv b/t/lib/warnings/gv index f3334456..85e4c0a 100644 --- a/t/lib/warnings/gv +++ b/t/lib/warnings/gv @@ -14,6 +14,8 @@ $a = ${"#"} ; $a = ${"*"} ; + ${^ENCODING} is no longer supported. + Name "main::a" used only once: possible typo Mandatory Warnings ALL TODO @@ -115,6 +117,14 @@ $# is no longer supported at - line 2. $* is no longer supported at - line 3. ######## # gv.c +$a = ${^ENCODING}; +$a = ${^E_NCODING}; +${^ENCODING} = 1; +${^E_NCODING} = 1; # We pretend this variable never existed. +EXPECT +${^ENCODING} is no longer supported at - line 4. +######## +# gv.c use warnings 'syntax' ; use utf8; use open qw( :utf8 :std ); diff --git a/t/lib/warnings/mg b/t/lib/warnings/mg index 6bd6c3a..5fe2a88 100644 --- a/t/lib/warnings/mg +++ b/t/lib/warnings/mg @@ -110,5 +110,5 @@ ${^ENCODING} = 42; ${^ENCODING} = undef; { local ${^ENCODING} = 37; } EXPECT -Setting ${^ENCODING} is deprecated at - line 1. -Setting ${^ENCODING} is deprecated at - line 4. +${^ENCODING} is no longer supported at - line 1. +${^ENCODING} is no longer supported at - line 4. diff --git a/t/lib/warnings/pp b/t/lib/warnings/pp index 3324ccc..3eef12a 100644 --- a/t/lib/warnings/pp +++ b/t/lib/warnings/pp @@ -21,6 +21,10 @@ Constant subroutine (anonymous) undefined $foo = sub () { 3 }; undef &$foo; + Use of strings with code points over 0xFF as arguments to 1's complement (~) operator is deprecated + + Invalid negative number (%s) in chr + __END__ # pp.c use warnings 'substr' ; @@ -136,3 +140,9 @@ EXPECT OPTION regex Use of strings with code points over 0xFF as arguments to 1's complement \(~\) operator is deprecated at - line \d+. Use of code point 0xFF+EFF is deprecated; the permissible max is 0x7F+ at - line \d+. +######## +# NAME chr -1 +use warnings 'utf8'; +my $chr = chr(-1); +EXPECT +Invalid negative number (-1) in chr at - line 2. diff --git a/t/op/concat2.t b/t/op/concat2.t index b1f707d..363bcf8 100644 --- a/t/op/concat2.t +++ b/t/op/concat2.t @@ -12,19 +12,7 @@ BEGIN { require './test.pl'; } -plan 3; - -SKIP: { -skip("no encoding pragma in EBCDIC", 1) if $::IS_EBCDIC; -skip_if_miniperl("no dynamic loading on miniperl, no Encode", 1); -fresh_perl_is <<'end', "ok\n", {}, - no warnings 'deprecated'; - use encoding 'utf8'; - map { "a" . $a } ((1)x5000); - print "ok\n"; -end - "concat does not lose its stack pointer after utf8 upgrade [perl #78674]"; -} +plan 2; # This test is in the file because overload.pm uses concatenation. { package o; use overload '""' => sub { $_[0][0] } } diff --git a/t/op/magic.t b/t/op/magic.t index da7532e..ad90749 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -675,11 +675,14 @@ is ${^MPEN}, undef, '${^MPEN} starts undefined'; # This one used to croak due to that missing break: is ++${^MPEN}, 1, '${^MPEN} can be incremented'; -eval { ${^E_NCODING} = 1 }; -like $@, qr/^Modification of a /, 'Setting ${^E_NCODING} croaks'; -$_ = ${^E_NCODING}; -pass('can read ${^E_NCODING} without blowing up'); -is $_, undef, '${^E_NCODING} is undef'; +{ + no warnings 'deprecated'; + eval { ${^E_NCODING} = 1 }; + is $@, "", 'Setting ${^E_NCODING} does nothing'; + $_ = ${^E_NCODING}; + pass('can read ${^E_NCODING} without blowing up'); + is $_, 1, '${^E_NCODING} is whatever it was set to'; +} { my $warned = 0; diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 6dcb150..49fd57d 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -1,5 +1,5 @@ Encode cpan/Encode/Byte/Makefile.PL 54f446297d614331ef3f51e8310faff27cc44f90 -Encode cpan/Encode/encoding.pm 51c19efc9bfe8467d6ae12a4654f6e7f980715bf +Encode cpan/Encode/encoding.pm 45bf1ee76bbed15d721427c04c8b6e104a0d39b6 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t a0369c919e216fb02767a637666bb4577ad79b02 ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/basic.t b7ee8691baf37197bf4249534f429fcf28f5cedf ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm 27aaa6acefd4223b57de74299314c19891ed17bc diff --git a/t/uni/chomp.t b/t/uni/chomp.t index ea86a25..35060ee 100644 --- a/t/uni/chomp.t +++ b/t/uni/chomp.t @@ -3,43 +3,19 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("encoding doesn't work with EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } use strict; -use Encode; -# %mbchars = (encoding => { bytes => utf8, ... }, ...); -# * pack('C*') is expected to return bytes even if ${^ENCODING} is true. -our %mbchars = ( - 'big-5' => { - pack('C*', 0x40) => pack('U*', 0x40), # COMMERCIAL AT - pack('C*', 0xA4, 0x40) => "\x{4E00}", # CJK-4E00 - }, - 'euc-jp' => { - pack('C*', 0xB0, 0xA1) => "\x{4E9C}", # CJK-4E9C - pack('C*', 0x8F, 0xB0, 0xA1) => "\x{4E02}", # CJK-4E02 - }, - 'shift-jis' => { - pack('C*', 0xA9) => "\x{FF69}", # halfwidth katakana small U - pack('C*', 0x82, 0xA9) => "\x{304B}", # hiragana KA - }, -); - -# 4 == @char; paired tests inside 3 nested loops, +# 6 == @char; paired tests inside 3 nested loops, # plus extra pair of tests in a loop, plus extra pair of tests. -plan tests => 2 * (4 ** 3 + 4 + 1) * (keys %mbchars); +plan tests => 6 ** 3 * 2 + 6 * 2 + 2; -for my $enc (sort keys %mbchars) { - no warnings 'deprecated'; - local ${^ENCODING} = find_encoding($enc); - use warnings 'deprecated'; - my @char = (sort(keys %{ $mbchars{$enc} }), - sort(values %{ $mbchars{$enc} })); +my @char = (pack('U*', 0x40), "\x{4E00}", "\x{4E9C}", "\x{4E02}", + "\x{FF69}", "\x{304B}"); - for my $rs (@char) { +for my $rs (@char) { local $/ = $rs; for my $start (@char) { for my $end (@char) { @@ -64,10 +40,10 @@ for my $enc (sort keys %mbchars) { my $got = chomp(); is ($got, 0); is (ref($_), "ARRAY", "chomp ref (no modify)"); - } - - $/ = ")"; # the last char of something like "ARRAY(0x80ff6e4)" - my $got = chomp(); - is ($got, 1); - ok (!ref($_), "chomp ref (modify)"); } + +$/ = ")"; # the last char of something like "ARRAY(0x80ff6e4)" +my $got = chomp(); +is ($got, 1); +ok (!ref($_), "chomp ref (modify)"); + diff --git a/t/uni/chr.t b/t/uni/chr.t deleted file mode 100644 index 390cdb1..0000000 --- a/t/uni/chr.t +++ /dev/null @@ -1,33 +0,0 @@ -#!./perl -w - -BEGIN { - chdir 't' if -d 't'; - require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; - skip_all_without_perlio(); -} - -use strict; -plan (tests => 8); -no warnings 'deprecated'; -use encoding 'johab'; - -ok(chr(0x7f) eq "\x7f"); -ok(chr(0x80) eq "\x80"); -ok(chr(0xff) eq "\xff"); - -for my $i (127, 128, 255) { - ok(chr($i) eq pack('C', $i)); -} - -# [perl #83048] -{ - my $w; - local $SIG{__WARN__} = sub { $w .= $_[0] }; - my $chr = chr(-1); - is($chr, "\x{fffd}", "invalid values become REPLACEMENT CHARACTER"); - like($w, qr/^Invalid negative number \(-1\) in chr at /, "with a warning"); -} - -__END__ diff --git a/t/uni/greek.t b/t/uni/greek.t index 7d73ecb..fdc2a18 100644 --- a/t/uni/greek.t +++ b/t/uni/greek.t @@ -3,9 +3,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; - skip_all_without_perlio(); + skip_all("encoding.pm is no longer supported by the perl core"); } plan tests => 72; diff --git a/t/uni/latin2.t b/t/uni/latin2.t index ba67e09..2e51598 100644 --- a/t/uni/latin2.t +++ b/t/uni/latin2.t @@ -3,9 +3,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; - skip_all_without_perlio(); + skip_all("encoding.pm is no longer supported by the perl core"); } plan tests => 94; diff --git a/t/uni/tr_7jis.t b/t/uni/tr_7jis.t deleted file mode 100644 index d1735f9..0000000 --- a/t/uni/tr_7jis.t +++ /dev/null @@ -1,45 +0,0 @@ -#! perl -w -# -# This script is written intentionally in ISO-2022-JP -# requires Encode 1.83 or better to work -# -- dankogai - -BEGIN { - chdir 't' if -d 't'; - require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; - skip_all_without_perlio(); -} - -use strict; -plan(tests => 6); -no warnings 'deprecated'; -use encoding 'iso-2022-jp'; - -my @hiragana = map {chr} ord("$B$!(B")..ord("$B$s(B"); -my @katakana = map {chr} ord("$B%!(B")..ord("$B%s(B"); -my $hiragana = join('' => @hiragana); -my $katakana = join('' => @katakana); -my %h2k; @h2k{@hiragana} = @katakana; -my %k2h; @k2h{@katakana} = @hiragana; - -# print @hiragana, "\n"; - -my $str; - -$str = $hiragana; $str =~ tr/$B$!(B-$B$s(B/$B%!(B-$B%s(B/; -is($str, $katakana, "tr// # hiragana -> katakana"); -$str = $katakana; $str =~ tr/$B%!(B-$B%s(B/$B$!(B-$B$s(B/; -is($str, $hiragana, "tr// # hiragana -> katakana"); - -$str = $hiragana; eval qq(\$str =~ tr/$B$!(B-$B$s(B/$B%!(B-$B%s(B/); -is($str, $katakana, "eval qq(tr//) # hiragana -> katakana"); -$str = $katakana; eval qq(\$str =~ tr/$B%!(B-$B%s(B/$B$!(B-$B$s(B/); -is($str, $hiragana, "eval qq(tr//) # hiragana -> katakana"); - -$str = $hiragana; $str =~ s/([$B$!(B-$B$s(B])/$h2k{$1}/go; -is($str, $katakana, "s/// # hiragana -> katakana"); -$str = $katakana; $str =~ s/([$B%!(B-$B%s(B])/$k2h{$1}/go; -is($str, $hiragana, "s/// # hiragana -> katakana"); -__END__ diff --git a/t/uni/tr_eucjp.t b/t/uni/tr_eucjp.t deleted file mode 100644 index c5cccfa..0000000 --- a/t/uni/tr_eucjp.t +++ /dev/null @@ -1,44 +0,0 @@ -#! perl -w -# -# This script is written intentionally in EUC-JP -# -- dankogai - -BEGIN { - chdir 't' if -d 't'; - require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; - skip_all_without_perlio(); -} - -use strict; -plan(tests => 6); -no warnings 'deprecated'; -use encoding 'euc-jp'; - -my @hiragana = map {chr} ord("¤¡")..ord("¤ó"); -my @katakana = map {chr} ord("¥¡")..ord("¥ó"); -my $hiragana = join('' => @hiragana); -my $katakana = join('' => @katakana); -my %h2k; @h2k{@hiragana} = @katakana; -my %k2h; @k2h{@katakana} = @hiragana; - -# print @hiragana, "\n"; - -my $str; - -$str = $hiragana; $str =~ tr/¤¡-¤ó/¥¡-¥ó/; -is($str, $katakana, "tr// # hiragana -> katakana"); -$str = $katakana; $str =~ tr/¥¡-¥ó/¤¡-¤ó/; -is($str, $hiragana, "tr// # hiragana -> katakana"); - -$str = $hiragana; eval qq(\$str =~ tr/¤¡-¤ó/¥¡-¥ó/); -is($str, $katakana, "eval qq(tr//) # hiragana -> katakana"); -$str = $katakana; eval qq(\$str =~ tr/¥¡-¥ó/¤¡-¤ó/); -is($str, $hiragana, "eval qq(tr//) # hiragana -> katakana"); - -$str = $hiragana; $str =~ s/([¤¡-¤ó])/$h2k{$1}/go; -is($str, $katakana, "s/// # hiragana -> katakana"); -$str = $katakana; $str =~ s/([¥¡-¥ó])/$k2h{$1}/go; -is($str, $hiragana, "s/// # hiragana -> katakana"); -__END__ diff --git a/t/uni/tr_sjis.t b/t/uni/tr_sjis.t deleted file mode 100644 index fec525d..0000000 --- a/t/uni/tr_sjis.t +++ /dev/null @@ -1,44 +0,0 @@ -#!perl -w -# -# This script is written intentionally in Shift JIS -# -- dankogai - -BEGIN { - chdir 't' if -d 't'; - require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; - skip_all_without_perlio(); -} - -use strict; -plan(tests => 6); -no warnings 'deprecated'; -use encoding 'shiftjis'; - -my @hiragana = map {chr} ord("")..ord("ñ"); -my @katakana = map {chr} ord("@")..ord(""); -my $hiragana = join('' => @hiragana); -my $katakana = join('' => @katakana); -my %h2k; @h2k{@hiragana} = @katakana; -my %k2h; @k2h{@katakana} = @hiragana; - -# print @hiragana, "\n"; - -my $str; - -$str = $hiragana; $str =~ tr/-ñ/@-/; -is($str, $katakana, "tr// # hiragana -> katakana"); -$str = $katakana; $str =~ tr/@-/-ñ/; -is($str, $hiragana, "tr// # hiragana -> katakana"); - -$str = $hiragana; eval qq(\$str =~ tr/-ñ/@-/); -is($str, $katakana, "eval qq(tr//) # hiragana -> katakana"); -$str = $katakana; eval qq(\$str =~ tr/@-/-ñ/); -is($str, $hiragana, "eval qq(tr//) # hiragana -> katakana"); - -$str = $hiragana; $str =~ s/([-ñ])/$h2k{$1}/go; -is($str, $katakana, "s/// # hiragana -> katakana"); -$str = $katakana; $str =~ s/([@-])/$k2h{$1}/go; -is($str, $hiragana, "s/// # hiragana -> katakana"); -__END__ diff --git a/t/uni/tr_utf8.t b/t/uni/tr_utf8.t index 59782f1..7d16969 100644 --- a/t/uni/tr_utf8.t +++ b/t/uni/tr_utf8.t @@ -1,21 +1,17 @@ #!perl -w # # This script is written intentionally in UTF-8 -# Requires Encode 1.83 or better # -- dankogai BEGIN { chdir 't' if -d 't'; require './test.pl'; - skip_all_without_dynamic_extension('Encode'); - skip_all("no encoding pragma in EBCDIC") if $::IS_EBCDIC; skip_all_without_perlio(); } use strict; plan(tests => 8); -no warnings 'deprecated'; -use encoding 'utf8'; +use utf8; my @hiragana = map {chr} ord("ã")..ord("ã"); my @katakana = map {chr} ord("ã¡")..ord("ã³"); diff --git a/toke.c b/toke.c index c359813..f26c211 100644 --- a/toke.c +++ b/toke.c @@ -3798,11 +3798,6 @@ S_scan_const(pTHX_ char *start) " >= %"UVuf, (UV)SvCUR(sv), (UV)SvLEN(sv)); SvPOK_on(sv); - if (IN_ENCODING && !has_utf8) { - sv_recode_to_utf8(sv, _get_encoding()); - if (SvUTF8(sv)) - has_utf8 = TRUE; - } if (has_utf8) { SvUTF8_on(sv); if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) { @@ -7278,24 +7273,6 @@ Perl_yylex(pTHX) if (!IN_BYTES) { if (UTF) PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8"); - else if (IN_ENCODING) { - SV *name; - dSP; - ENTER; - SAVETMPS; - PUSHMARK(sp); - XPUSHs(_get_encoding()); - PUTBACK; - call_method("name", G_SCALAR); - SPAGAIN; - name = POPs; - PUTBACK; - PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, - Perl_form(aTHX_ ":encoding(%"SVf")", - SVfARG(name))); - FREETMPS; - LEAVE; - } } #endif PL_rsfp = NULL; @@ -9698,8 +9675,6 @@ S_scan_heredoc(pTHX_ char *s) if (!IN_BYTES) { if (UTF && is_utf8_string((U8*)SvPVX_const(tmpstr), SvCUR(tmpstr))) SvUTF8_on(tmpstr); - else if (IN_ENCODING) - sv_recode_to_utf8(tmpstr, _get_encoding()); } PL_lex_stuff = tmpstr; pl_yylval.ival = op_type; @@ -9936,7 +9911,6 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re I32 termcode; /* terminating char. code */ U8 termstr[UTF8_MAXBYTES]; /* terminating string */ STRLEN termlen; /* length of terminating string */ - int last_off = 0; /* last position for nesting bracket */ line_t herelines; PERL_ARGS_ASSERT_SCAN_STR; @@ -9989,116 +9963,6 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re sv_catpvn(sv, s, termlen); s += termlen; for (;;) { - if (IN_ENCODING && !UTF && !re_reparse) { - bool cont = TRUE; - - while (cont) { - int offset = s - SvPVX_const(PL_linestr); - const bool found = sv_cat_decode(sv, _get_encoding(), PL_linestr, - &offset, (char*)termstr, termlen); - const char *ns; - char *svlast; - - if (SvIsCOW(PL_linestr)) { - STRLEN bufend_pos, bufptr_pos, oldbufptr_pos; - STRLEN oldoldbufptr_pos, linestart_pos, last_uni_pos; - STRLEN last_lop_pos, re_eval_start_pos, s_pos; - char *buf = SvPVX(PL_linestr); - bufend_pos = PL_parser->bufend - buf; - bufptr_pos = PL_parser->bufptr - buf; - oldbufptr_pos = PL_parser->oldbufptr - buf; - oldoldbufptr_pos = PL_parser->oldoldbufptr - buf; - linestart_pos = PL_parser->linestart - buf; - last_uni_pos = PL_parser->last_uni - ? PL_parser->last_uni - buf - : 0; - last_lop_pos = PL_parser->last_lop - ? PL_parser->last_lop - buf - : 0; - re_eval_start_pos = - PL_parser->lex_shared->re_eval_start ? - PL_parser->lex_shared->re_eval_start - buf : 0; - s_pos = s - buf; - - sv_force_normal(PL_linestr); - - buf = SvPVX(PL_linestr); - PL_parser->bufend = buf + bufend_pos; - PL_parser->bufptr = buf + bufptr_pos; - PL_parser->oldbufptr = buf + oldbufptr_pos; - PL_parser->oldoldbufptr = buf + oldoldbufptr_pos; - PL_parser->linestart = buf + linestart_pos; - if (PL_parser->last_uni) - PL_parser->last_uni = buf + last_uni_pos; - if (PL_parser->last_lop) - PL_parser->last_lop = buf + last_lop_pos; - if (PL_parser->lex_shared->re_eval_start) - PL_parser->lex_shared->re_eval_start = - buf + re_eval_start_pos; - s = buf + s_pos; - } - ns = SvPVX_const(PL_linestr) + offset; - svlast = SvEND(sv) - 1; - - for (; s < ns; s++) { - if (*s == '\n' && !PL_rsfp && !PL_parser->filtered) - COPLINE_INC_WITH_HERELINES; - } - if (!found) - goto read_more_line; - else { - /* handle quoted delimiters */ - if (SvCUR(sv) > 1 && *(svlast-1) == '\\') { - const char *t; - for (t = svlast-2; t >= SvPVX_const(sv) && *t == '\\';) - t--; - if ((svlast-1 - t) % 2) { - if (!keep_bracketed_quoted) { - *(svlast-1) = term; - *svlast = '\0'; - SvCUR_set(sv, SvCUR(sv) - 1); - } - continue; - } - } - if (PL_multi_open == PL_multi_close) { - cont = FALSE; - } - else { - const char *t; - char *w; - for (t = w = SvPVX(sv)+last_off; t < svlast; w++, t++) { - /* At here, all closes are "was quoted" one, - so we don't check PL_multi_close. */ - if (*t == '\\') { - if (!keep_bracketed_quoted && *(t+1) == PL_multi_open) - t++; - else - *w++ = *t++; - } - else if (*t == PL_multi_open) - brackets++; - - *w = *t; - } - if (w < t) { - *w++ = term; - *w = '\0'; - SvCUR_set(sv, w - SvPVX_const(sv)); - } - last_off = w - SvPVX(sv); - if (--brackets <= 0) - cont = FALSE; - } - } - } - if (!keep_delims) { - SvCUR_set(sv, SvCUR(sv) - 1); - *SvEND(sv) = '\0'; - } - break; - } - /* extend sv if need be */ SvGROW(sv, SvCUR(sv) + (PL_bufend - s) + 1); /* set 'to' to the next character in the sv's string */ @@ -10191,7 +10055,6 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re to[-1] = '\n'; #endif - read_more_line: /* if we're out of file, or a read fails, bail and reset the current line marker so we can report where the unterminated string began */ @@ -10207,13 +10070,11 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re /* at this point, we have successfully read the delimited string */ - if (!IN_ENCODING || UTF || re_reparse) { - - if (keep_delims) + if (keep_delims) sv_catpvn(sv, s, termlen); - s += termlen; - } - if (has_utf8 || (IN_ENCODING && !re_reparse)) + s += termlen; + + if (has_utf8) SvUTF8_on(sv); PL_multi_end = CopLINE(PL_curcop); @@ -10950,8 +10811,6 @@ S_scan_formline(pTHX_ char *s) if (!IN_BYTES) { if (UTF && is_utf8_string((U8*)SvPVX_const(stuff), SvCUR(stuff))) SvUTF8_on(stuff); - else if (IN_ENCODING) - sv_recode_to_utf8(stuff, _get_encoding()); } NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, stuff); force_next(THING); -- Perl5 Master Repository
