diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs index a4790ddd0f0a..126f6506693f 100644 --- a/cpan/Scalar-List-Utils/ListUtil.xs +++ b/cpan/Scalar-List-Utils/ListUtil.xs @@ -1947,8 +1947,10 @@ PREINIT: STRLEN namelen; const char* nameptr = SvPV(name, namelen); int utf8flag = SvUTF8(name); +#if PERL_VERSION_LT(5, 41, 3) int quotes_seen = 0; bool need_subst = FALSE; +#endif PPCODE: if (!SvROK(sub) && SvGMAGICAL(sub)) mg_get(sub); @@ -1971,18 +1973,23 @@ PPCODE: if (s > nameptr && *s == ':' && s[-1] == ':') { end = s - 1; begin = ++s; +#if PERL_VERSION_LT(5, 41, 3) if (quotes_seen) need_subst = TRUE; +#endif } +#if PERL_VERSION_LT(5, 41, 3) else if (s > nameptr && *s != '\0' && s[-1] == '\'') { end = s - 1; begin = s; if (quotes_seen++) need_subst = TRUE; } +#endif } s--; if (end) { +#if PERL_VERSION_LT(5, 41, 3) SV* tmp; if (need_subst) { STRLEN length = end - nameptr + quotes_seen - (*end == '\'' ? 1 : 0); @@ -2002,6 +2009,7 @@ PPCODE: stash = gv_stashpvn(left, length, GV_ADD | utf8flag); } else +#endif stash = gv_stashpvn(nameptr, end - nameptr, GV_ADD | utf8flag); nameptr = begin; namelen -= begin - nameptr; diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm index 3766b06d89f8..bbf5383d958c 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util.pm @@ -16,7 +16,7 @@ our @EXPORT_OK = qw( sample shuffle uniq uniqint uniqnum uniqstr zip zip_longest zip_shortest mesh mesh_longest mesh_shortest head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst ); -our $VERSION = "1.63"; +our $VERSION = "1.63_01"; our $XS_VERSION = $VERSION; $VERSION =~ tr/_//d; diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm index 28cf6928f4fb..dad8070da8c9 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm @@ -3,7 +3,7 @@ use strict; use warnings; use List::Util; -our $VERSION = "1.63"; # FIXUP +our $VERSION = "1.63_01"; # FIXUP $VERSION =~ tr/_//d; # FIXUP 1; diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm index 760e641ebf24..b0fd49e58631 100644 --- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm @@ -17,7 +17,7 @@ our @EXPORT_OK = qw( dualvar isdual isvstring looks_like_number openhandle readonly set_prototype tainted ); -our $VERSION = "1.63"; +our $VERSION = "1.63_01"; $VERSION =~ tr/_//d; require List::Util; # List::Util loads the XS diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm index f96e857c2819..594072d484ce 100644 --- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm @@ -15,7 +15,7 @@ our @EXPORT_OK = qw( subname set_subname ); -our $VERSION = "1.63"; +our $VERSION = "1.63_01"; $VERSION =~ tr/_//d; require List::Util; # as it has the XS diff --git a/cpan/Scalar-List-Utils/t/exotic_names.t b/cpan/Scalar-List-Utils/t/exotic_names.t index c51114a6acdb..7c43d03c49e9 100644 --- a/cpan/Scalar-List-Utils/t/exotic_names.t +++ b/cpan/Scalar-List-Utils/t/exotic_names.t @@ -45,7 +45,7 @@ sub caller3_ok { ), ); - $expected =~ s/'/::/g; + $expected =~ s/'/::/g if $] < 5.041_003; # this is apparently how things worked before 5.16 utf8::encode($expected) if $] < 5.016 and $ord > 255; @@ -83,7 +83,8 @@ push @ordinal, plan tests => @ordinal * 2 * 3; -my $legal_ident_char = "A-Z_a-z0-9'"; +my $legal_ident_char = "A-Z_a-z0-9"; +$legal_ident_char .= "'" if $] < 5.041_003; $legal_ident_char .= join '', map chr, 0x100, 0x498 unless $] < 5.008; diff --git a/cpan/parent/lib/parent.pm b/cpan/parent/lib/parent.pm index 483aa3e02571..e6cdf3846cc5 100644 --- a/cpan/parent/lib/parent.pm +++ b/cpan/parent/lib/parent.pm @@ -1,7 +1,7 @@ package parent; use strict; -our $VERSION = '0.241'; +our $VERSION = '0.241_001'; sub import { my $class = shift; diff --git a/cpan/parent/t/compile-time-file.t b/cpan/parent/t/compile-time-file.t index bff886155297..0fcf8d8a2a65 100644 --- a/cpan/parent/t/compile-time-file.t +++ b/cpan/parent/t/compile-time-file.t @@ -24,7 +24,7 @@ use lib 't/lib'; { package Child3; - use parent "Dummy'Outside"; + use if $] < 5.041_003, parent => "Dummy'Outside"; } my $obj = {}; @@ -39,9 +39,13 @@ isa_ok $obj, 'Dummy::InlineChild'; can_ok $obj, 'exclaim'; is $obj->exclaim, "I CAN FROM Dummy::InlineChild", 'Inheritance is set up correctly for inlined classes'; +SKIP: +{ + skip "No ' in names from 5.041_003", 3 if $] >= 5.041_003; $obj = {}; bless $obj, 'Child3'; isa_ok $obj, 'Dummy::Outside'; can_ok $obj, 'exclaim'; is $obj->exclaim, "I CAN FROM Dummy::Outside", "Inheritance is set up correctly for classes inherited from via '"; +} diff --git a/embed.fnc b/embed.fnc index a609abb7b098..a56cdef668ec 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2995,12 +2995,6 @@ EXpx |char * |scan_word |NN char *s \ |STRLEN destlen \ |int allow_package \ |NN STRLEN *slp -EXpx |char * |scan_word6 |NN char *s \ - |NN char *dest \ - |STRLEN destlen \ - |int allow_package \ - |NN STRLEN *slp \ - |bool warn_tick Cp |U32 |seed : Only used by perl.c/miniperl.c, but defined in caretx.c ep |void |set_caret_X @@ -5894,8 +5888,7 @@ S |void |parse_ident |NN char **s \ |NN char * const e \ |int allow_package \ |bool is_utf8 \ - |bool check_dollar \ - |bool tick_warn + |bool check_dollar S |int |pending_ident RS |char * |scan_const |NN char *start RS |char * |scan_formline |NN char *s diff --git a/embed.h b/embed.h index b4dd72c02169..84c378121c73 100644 --- a/embed.h +++ b/embed.h @@ -1629,7 +1629,7 @@ # define lop(a,b,c) S_lop(aTHX_ a,b,c) # define missingterm(a,b) S_missingterm(aTHX_ a,b) # define no_op(a,b) S_no_op(aTHX_ a,b) -# define parse_ident(a,b,c,d,e,f,g) S_parse_ident(aTHX_ a,b,c,d,e,f,g) +# define parse_ident(a,b,c,d,e,f) S_parse_ident(aTHX_ a,b,c,d,e,f) # define pending_ident() S_pending_ident(aTHX) # define scan_const(a) S_scan_const(aTHX_ a) # define scan_formline(a) S_scan_formline(aTHX_ a) @@ -1765,7 +1765,6 @@ # define report_uninit(a) Perl_report_uninit(aTHX_ a) # define scan_str(a,b,c,d,e) Perl_scan_str(aTHX_ a,b,c,d,e) # define scan_word(a,b,c,d,e) Perl_scan_word(aTHX_ a,b,c,d,e) -# define scan_word6(a,b,c,d,e,f) Perl_scan_word6(aTHX_ a,b,c,d,e,f) # define skipspace_flags(a,b) Perl_skipspace_flags(aTHX_ a,b) # define sv_magicext_mglob(a) Perl_sv_magicext_mglob(aTHX_ a) # define sv_only_taint_gmagic Perl_sv_only_taint_gmagic diff --git a/gv.c b/gv.c index 417c689f66a7..041b2701a30f 100644 --- a/gv.c +++ b/gv.c @@ -1179,7 +1179,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le * method name. * * leaves last_separator pointing to the beginning of the - * last package separator (either ' or ::) or 0 + * last package separator (::) or 0 * if none was found. * * leaves name pointing at the beginning of the @@ -1188,11 +1188,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le const char *name_cursor = name; const char * const name_em1 = name_end - 1; /* name_end minus 1 */ for (name_cursor = name; name_cursor < name_end ; name_cursor++) { - if (*name_cursor == '\'') { - last_separator = name_cursor; - name = name_cursor + 1; - } - else if (name_cursor < name_em1 && *name_cursor == ':' && name_cursor[1] == ':') { + if (name_cursor < name_em1 && *name_cursor == ':' && name_cursor[1] == ':') { last_separator = name_cursor++; name = name_cursor + 1; } @@ -1802,7 +1798,6 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; - char smallbuf[64]; /* small buffer to avoid a malloc when possible */ PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME; @@ -1816,8 +1811,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, for (name_cursor = *name; name_cursor < name_end; name_cursor++) { if (name_cursor < name_em1 && - ((*name_cursor == ':' && name_cursor[1] == ':') - || *name_cursor == '\'')) + (*name_cursor == ':' && name_cursor[1] == ':')) { if (!*stash) *stash = PL_defstash; @@ -1832,22 +1826,6 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, key = *name; *len += 2; } - else { /* using ' for package separator */ - /* use our pre-allocated buffer when possible to save a malloc */ - char *tmpbuf; - if ( *len+2 <= sizeof smallbuf) - tmpbuf = smallbuf; - else { - /* only malloc once if needed */ - if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */ - Newx(tmpfullbuf, full_len+2, char); - tmpbuf = tmpfullbuf; - } - Copy(*name, tmpbuf, *len, char); - tmpbuf[(*len)++] = ':'; - tmpbuf[(*len)++] = ':'; - key = tmpbuf; - } gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; if (!*gv || *gv == (const GV *)&PL_sv_undef) { diff --git a/lib/overload.t b/lib/overload.t index 6447acd0f008..7f8cb48a7d78 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -2399,7 +2399,7 @@ is eval {"$a"}, overload::StrVal($a), { package mane; use overload q\""\ => "bear::strength"; - use overload bool => "bear'bouillon"; + use overload bool => "bear::bouillon"; } @bear::ISA = 'food'; sub food::strength { 'twine' } diff --git a/mg.c b/mg.c index d972781ff1fe..c37707be462d 100644 --- a/mg.c +++ b/mg.c @@ -1853,7 +1853,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) * access to a known hint bit in a known OP, we can't * tell whether HINT_STRICT_REFS is in force or not. */ - if (!memchr(s, ':', len) && !memchr(s, '\'', len)) + if (!memchr(s, ':', len)) Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"), SV_GMAGIC); if (i) diff --git a/op.c b/op.c index 4523b6b3a9a1..4026ca15427c 100644 --- a/op.c +++ b/op.c @@ -10758,7 +10758,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, ec ? GV_NOADD_NOINIT : (IN_PERL_RUNTIME && PL_curstash != CopSTASH(PL_curcop)) || PL_curstash != PL_defstash - || memchr(name, ':', namlen) || memchr(name, '\'', namlen) + || memchr(name, ':', namlen) ? gv_fetch_flags : GV_ADDMULTI | GV_NOINIT | GV_NOTQUAL; gv = gv_fetchsv(cSVOPo->op_sv, flags, SVt_PVCV); @@ -13419,7 +13419,6 @@ Perl_ck_method(pTHX_ OP *o) { SV *sv, *methsv, *rclass; const char* method; - char* compatptr; int utf8; STRLEN len, nsplit = 0, i; OP* new_op; @@ -13430,14 +13429,6 @@ Perl_ck_method(pTHX_ OP *o) sv = kSVOP->op_sv; - /* replace ' with :: */ - while ((compatptr = (char *) memchr(SvPVX(sv), '\'', - SvEND(sv) - SvPVX(sv) ))) - { - *compatptr = ':'; - sv_insert(sv, compatptr - SvPVX_const(sv), 0, ":", 1); - } - method = SvPVX_const(sv); len = SvCUR(sv); utf8 = SvUTF8(sv) ? -1 : 1; diff --git a/pod/perldata.pod b/pod/perldata.pod index 80179f78dc84..da52274876d1 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -136,22 +136,17 @@ generic characters, and identifiers should match That is, any word character in the ASCII range, as long as the first character is not a digit. -There are two package separators in Perl: A double colon (C<::>) and a single -quote (C<'>). Use of C<'> as the package separator is deprecated and will be -removed in Perl 5.40. Normal identifiers can start or end with a double -colon, and can contain several parts delimited by double colons. Single -quotes have similar rules, but with the exception that they are not legal at -the end of an identifier: That is, C<$'foo> and C<$foo'bar> are legal, but -C<$foo'bar'> is not. +There is one package separator in Perl: A double colon (C<::>). +Normal identifiers can start or end with a double colon, and can +contain several parts delimited by double colons. + +Previously you could use C<'> as a package separator, this was removed +in Perl 5.42. Additionally, if the identifier is preceded by a sigil -- that is, if the identifier is part of a variable name -- it may optionally be enclosed in braces. -While you can mix double colons with singles quotes, the quotes must come -after the colons: C<$::::'foo> and C<$foo::'bar> are legal, but C<$::'::foo> -and C<$foo'::bar> are not. - Put together, a grammar to match a basic identifier becomes / @@ -164,9 +159,9 @@ Put together, a grammar to match a basic identifier becomes ) ) (? - (?: :: )* '? + (?: :: )* (?&basic_identifier) - (?: (?= (?: :: )+ '? | (?: :: )* ' ) (?&normal_identifier) )? + (?: (?= :: ) (?&normal_identifier) )? (?: :: )* ) (? diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3752d07e8fdd..017832e728a7 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -487,7 +487,7 @@ results. of Perl. Check the #! line, or manually feed your script into Perl yourself. -=item Bad name after %s +=item Bad name after %s:: (F) You started to name a symbol by using a package prefix, and then didn't finish the symbol. In particular, you can't interpolate outside @@ -4797,22 +4797,6 @@ Cing a file, or when seeking past the end of a scalar opened for I/O (in anticipation of future reads and to imitate the behavior with real files). -=item Old package separator "'" deprecated - -(D deprecated::apostrophe_as_package_separator, syntax) You used the old package -separator "'" in a variable, subroutine or package name. Support for the -old package separator will be removed in Perl 5.42. - -=item Old package separator used in string - -(D deprecated::apostrophe_as_package_separator, syntax) You used the old package -separator, "'", in a variable named inside a double-quoted string; e.g., -C<"In $name's house">. This is equivalent to C<"In $name::s house">. If -you meant the former, put a backslash before the apostrophe -(C<"In $name\'s house">). - -Support for the old package separator will be removed in Perl 5.42. - =item Only scalar fields can take a :param attribute (F) You tried to apply the C<:param> attribute to an array or hash field. diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 117142f2e94f..63516e55e2bb 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -69,21 +69,6 @@ colon: C<$Package::Variable>. If the package name is null, the C
package is assumed. That is, C<$::sail> is equivalent to C<$main::sail>. -The old package delimiter was a single quote, but double colon is now the -preferred delimiter, in part because it's more readable to humans, and -in part because it's more readable to B macros. It also makes C++ -programmers feel like they know what's going on--as opposed to using the -single quote as separator, which was there to make Ada programmers feel -like they knew what was going on. Because the old-fashioned syntax is still -supported for backwards compatibility, if you try to use a string like -C<"This is $owner's house">, you'll be accessing C<$owner::s>; that is, -the $s variable in package C, which is probably not what you meant. -Use braces to disambiguate, as in C<"This is ${owner}'s house">. -X<::> X<'> - -Using C<'> as a package separator is deprecated and will be removed in -Perl 5.40. - Packages may themselves contain package separators, as in C<$OUTER::INNER::var>. This implies nothing about the order of name lookups, however. There are no relative packages: all symbols @@ -94,6 +79,9 @@ C<$OUTER::INNER::var>. C refers to a totally separate global package. The custom of treating package names as a hierarchy is very strong, but the language in no way enforces it. +Previously you could use C<'> as a package separator, this was removed +in Perl 5.42. + Only identifiers starting with letters (or underscore) are stored in a package's symbol table. All other symbols are kept in package C
, including all punctuation variables, like $_. In addition, diff --git a/proto.h b/proto.h index 0aa679149e34..9c4a1488ba9f 100644 --- a/proto.h +++ b/proto.h @@ -4183,11 +4183,6 @@ Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STR #define PERL_ARGS_ASSERT_SCAN_WORD \ assert(s); assert(dest); assert(slp) -PERL_CALLCONV char * -Perl_scan_word6(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp, bool warn_tick); -#define PERL_ARGS_ASSERT_SCAN_WORD6 \ - assert(s); assert(dest); assert(slp) - PERL_CALLCONV U32 Perl_seed(pTHX); #define PERL_ARGS_ASSERT_SEED @@ -9309,7 +9304,7 @@ S_no_op(pTHX_ const char * const what, char *s); assert(what) STATIC void -S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar, bool tick_warn); +S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar); # define PERL_ARGS_ASSERT_PARSE_IDENT \ assert(s); assert(d); assert(e) diff --git a/t/comp/package.t b/t/comp/package.t index 7b19513bddf2..d3e8850a4511 100644 --- a/t/comp/package.t +++ b/t/comp/package.t @@ -18,15 +18,12 @@ $bar = 4; { package ABC; - no warnings qw(syntax deprecated); $blurfl = 5; - $main'a = $'b; -} -{ - no warnings qw(syntax deprecated); - $ABC'dyick = 6; + $main::a = $::b; } +$ABC::dyick = 6; + $xyz = 2; $main = join(':', sort(keys %main::)); @@ -36,13 +33,10 @@ $ABC = join(':', sort(keys %ABC::)); if ('a' lt 'A') { print $xyz eq 'bar:main:new:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n"; } else { - print $xyz eq 'ABC:BEGIN:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n"; -} -print $ABC eq 'BEGIN:blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n"; -{ - no warnings qw(syntax deprecated); - print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n"; + print $xyz eq 'ABC:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n"; } +print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n"; +print $main::blurfl == 123 ? "ok 3\n" : "not ok 3\n"; package ABC; diff --git a/t/comp/parser.t b/t/comp/parser.t index dbd5ecc842bc..eaf50f36bb16 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -8,7 +8,7 @@ BEGIN { chdir 't' if -d 't'; } -print "1..191\n"; +print "1..189\n"; sub failed { my ($got, $expected, $name) = @_; @@ -222,8 +222,12 @@ EOF # tests for "Bad name" eval q{ foo::$bar }; like( $@, qr/Bad name after foo::/, 'Bad name after foo::' ); -eval q{ foo''bar }; -like( $@, qr/Bad name after foo'/, 'Bad name after foo\'' ); +{ + # since ' is no longer usable in symbols, the error is no longer "Bad name" + no warnings "syntax"; # suppress String found where operator expeected + eval q{ foo''bar }; + like( $@, qr/syntax error at \(eval \d+\) line 1, near "foo''/, 'Syntax error for foo\'' ); +} # test for ?: context error eval q{($a ? $x : ($y)) = 5}; @@ -368,12 +372,11 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' ); } { - no warnings; # [perl #113016] CORE::print::foo - sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate - sub CORE'foo'bar { 43 } + sub CORE::print::foo { 43 } + sub CORE::foo::bar { 43 } is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo'; - is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error"; + is scalar eval "CORE::foo::bar", 43, "CORE::foo'bar is not an error"; } # bug #71748 @@ -451,11 +454,6 @@ END eval 's/${< ( EXPECT Bareword found where operator expected (Do you need to predeclare "isa"?) at - line 9, near "isa => 'Int" (Might be a runaway multi-line '' string starting on line 4) -Bad name after Int' at - line 9. +syntax error at - line 9, near "isa => 'Int" +Execution of - aborted due to compilation errors. ######## # NAME Bad name after :: (with other helpful messages) sub has{} @@ -611,3 +612,18 @@ syntax error at - line 2, near "[ ==" (Might be a runaway multi-line // string starting on line 1) Execution of - aborted due to compilation errors. +######## +# NAME tick in names: initial character of sub name +sub 'Hello'_he_said (_); +EXPECT +Illegal declaration of anonymous subroutine at - line 1. +######## +# NAME tick in names: initial character of format name + format 'one = +ok @<< - format 'foo still works +$test +. +EXPECT +syntax error at - line 2, near "ok @<< - format '" + (Might be a runaway multi-line '' string starting on line 1) +Execution of - aborted due to compilation errors. diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index fc1c66378288..476108858e21 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -408,6 +408,10 @@ sort ("") EXPECT ######## +# NAME ' no longer is part of the symbol character set +# previously these would parse like: +# "${foo'bar}", but now they parse like "${foo}'bar" +# and any ' parsing for symbols is now gone, so no warning @foo::bar = 1..3; () = "$foo'bar"; () = "@foo'bar"; @@ -421,19 +425,8 @@ no warnings 'syntax', 'deprecated' ; () = "@foo'bar"; () = "$#foo'bar"; EXPECT -Old package separator used in string at - line 2. - (Did you mean "$foo\'bar" instead?) -Old package separator used in string at - line 3. - (Did you mean "@foo\'bar" instead?) -Old package separator used in string at - line 4. - (Did you mean "$#foo\'bar" instead?) -Old package separator used in string at - line 6. - (Did you mean "$foo\'bar" instead?) -Old package separator used in string at - line 7. - (Did you mean "@foo\'bar" instead?) -Old package separator used in string at - line 8. - (Did you mean "$#foo\'bar" instead?) ######## +# similar to the test above in that the parsing has changed use warnings 'syntax'; use utf8; @fooл::barл = 1..3; () = "$fooл'barл"; @@ -444,12 +437,7 @@ no warnings 'syntax', 'deprecated' ; () = "@fooл'barл"; () = "$#fooл'barл"; EXPECT -Old package separator used in string at - line 3. - (Did you mean "$fooл\'barл" instead?) -Old package separator used in string at - line 4. - (Did you mean "@fooл\'barл" instead?) -Old package separator used in string at - line 5. - (Did you mean "$#fooл\'barл" instead?) +Possible unintended interpolation of @fooл in string at - line 5. ######## # NAME deprecation of ' in names sub foo'bar { 1 } @@ -458,11 +446,8 @@ $a'b = 1; %a'd = (); package a'e; EXPECT -Old package separator "'" deprecated at - line 1. -Old package separator "'" deprecated at - line 2. -Old package separator "'" deprecated at - line 3. -Old package separator "'" deprecated at - line 4. -Old package separator "'" deprecated at - line 5. +OPTION fatal +Illegal declaration of subroutine main::foo at - line 1. ######## # toke.c use warnings 'ambiguous' ; diff --git a/t/op/magic.t b/t/op/magic.t index 49e39b7c7203..d13b6c5d8018 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc( '../lib' ); - plan (tests => 208); # some tests are run in BEGIN block + plan (tests => 209); # some tests are run in BEGIN block } # Test that defined() returns true for magic variables created on the fly, @@ -676,6 +676,14 @@ foreach my $sig (qw(__WARN__ INT)) { is delete $SIG{$sig}, undef, "$sig remains gone"; } +# test Perl_magic_setsig main:: qualification +# this previously did it for names containing ' +{ + local $SIG{INT} = "foo'bar"; + is($SIG{INT}, "main::foo'bar", + "' in signal handler name no longer a package separator"); +} + # And now one which doesn't exist; { no warnings 'signal'; diff --git a/t/op/method.t b/t/op/method.t index eaa129aee1c7..ddadb87420e6 100644 --- a/t/op/method.t +++ b/t/op/method.t @@ -13,7 +13,7 @@ BEGIN { use strict; no warnings 'once'; -plan(tests => 163); +plan(tests => 161); { # RT #126042 &{1==1} * &{1==1} would crash @@ -253,12 +253,6 @@ sub OtherSouper::method { "Isidore Ropen, Draft Manager" } my @ret = $o->SUPER::method('whatever'); ::is $ret[0], $o, 'object passed to SUPER::method'; ::is $ret[1], 'whatever', 'argument passed to SUPER::method'; - { - no warnings qw(syntax deprecated); - @ret = $o->SUPER'method('whatever'); - } - ::is $ret[0], $o, "object passed to SUPER'method"; - ::is $ret[1], 'whatever', "argument passed to SUPER'method"; @ret = Saab->SUPER::method; ::is $ret[0], 'Saab', "package name passed to SUPER::method"; @ret = OtherSaab->SUPER::method; diff --git a/t/op/ref.t b/t/op/ref.t index 3cf6ab047259..76b55b24ad9d 100644 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -272,10 +272,8 @@ is (join('', sort values %$anonhash2), 'BARXYZ'); # Test bless operator. package MYHASH; -{ - no warnings qw(syntax deprecated); - $object = bless $main'anonhash2; -} +$object = bless $main::anonhash2; + main::is (ref $object, 'MYHASH'); main::is ($object->{ABC}, 'XYZ'); @@ -299,10 +297,7 @@ sub mymethod { $string = "bad"; $object = "foo"; $string = "good"; -{ - no warnings qw(syntax deprecated); - $main'anonhash2 = "foo"; -} +$main::anonhash2 = "foo"; $string = ""; DESTROY { @@ -319,10 +314,7 @@ package OBJ; @ISA = ('BASEOBJ'); -{ - no warnings qw(syntax deprecated); - $main'object = bless {FOO => 'foo', BAR => 'bar'}; -} +$main::object = bless {FOO => 'foo', BAR => 'bar'}; package main; @@ -335,13 +327,10 @@ is ($object->doit("BAR"), 'bar'); $foo = doit $object "FOO"; main::is ($foo, 'foo'); -{ - no warnings qw(syntax deprecated); - sub BASEOBJ'doit { - local $ref = shift; - die "Not an OBJ" unless ref $ref eq 'OBJ'; - $ref->{shift()}; - } +sub BASEOBJ::doit { + local $ref = shift; + die "Not an OBJ" unless ref $ref eq 'OBJ'; + $ref->{shift()}; } package UNIVERSAL; diff --git a/t/op/sort.t b/t/op/sort.t index bdb965dcee63..19c99961ac05 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -240,7 +240,7 @@ eval <<'CODE'; no warnings qw(deprecated syntax); my @result = sort main'Backwards 'one', 'two'; CODE -cmp_ok($@,'eq','',q(old skool package)); +cmp_ok($@,'ne','',q(old skool package)); eval <<'CODE'; # "sort 'one', 'two'" should not try to parse "'one" as a sort sub diff --git a/t/op/stash.t b/t/op/stash.t index a507c4239db1..f10834adcc87 100644 --- a/t/op/stash.t +++ b/t/op/stash.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc( qw(../lib) ); } -plan( tests => 55 ); +plan( tests => 54 ); # Used to segfault (bug #15479) fresh_perl_like( @@ -301,10 +301,6 @@ fresh_perl_is( 'packages ending with :: are self-consistent'; } -# [perl #88138] ' not equivalent to :: before a null -${"a'\0b"} = "c"; -is ${"a::\0b"}, "c", "' is equivalent to :: before a null"; - # [perl #101486] Clobbering the current package ok eval ' package Do; diff --git a/t/op/stash_parse_gv.t b/t/op/stash_parse_gv.t index 9e143d979e15..465480e331eb 100644 --- a/t/op/stash_parse_gv.t +++ b/t/op/stash_parse_gv.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc(qw(../lib)); } -plan( tests => 5 ); +plan( tests => 3 ); my $long = 'x' x 100; my $short = 'abcd'; @@ -14,9 +14,7 @@ my $short = 'abcd'; my @tests = ( [ $long, 'long package name: one word' ], [ join( '::', $long, $long ), 'long package name: multiple words' ], - [ join( q['], $long, $long ), q[long package name: multiple words using "'" separator] ], [ join( '::', $long, $short, $long ), 'long & short package name: multiple words' ], - [ join( q['], $long, $short, $long ), q[long & short package name: multiple words using "'" separator] ], ); foreach my $t (@tests) { diff --git a/t/uni/package.t b/t/uni/package.t index d4e69ca38044..b615bf01120a 100644 --- a/t/uni/package.t +++ b/t/uni/package.t @@ -9,9 +9,6 @@ BEGIN { plan (tests => 18); -# Works on either ASCII or EBCDIC -my $prefix = ("a" lt "A") ? "bar:BEGIN" : "BEGIN:bar"; - use utf8; use open qw( :utf8 :std ); @@ -37,23 +34,17 @@ ok 1, "sanity check. If we got this far, UTF-8 in package names is legal."; $ㄅĽuṞfⳐ = 5; } - { - no warnings qw(syntax deprecated); - $압Ƈ'd읯ⱪ = 6; #' - } + $압Ƈ::d읯ⱪ = 6; $ꑭʑ = 2; $ꑭʑ = join(':', sort(keys %ꑭʑ::)); $압Ƈ = join(':', sort(keys %압Ƈ::)); - ::is $ꑭʑ, "$prefix:ニュー:ꑭʑ:압Ƈ", "comp/stash.t test 1"; + ::is $ꑭʑ, "bar:ニュー:ꑭʑ:압Ƈ", "comp/stash.t test 1"; ::is $압Ƈ, "d읯ⱪ:ㄅĽuṞfⳐ", "comp/stash.t test 2"; - { - no warnings qw(syntax deprecated); - ::is $main'ㄅĽuṞfⳐ, 123, "comp/stash.t test 3"; - } + ::is $main::ㄅĽuṞfⳐ, 123, "comp/stash.t test 3"; package 압Ƈ; diff --git a/t/uni/parser.t b/t/uni/parser.t index d3aa74527224..6fdd99749163 100644 --- a/t/uni/parser.t +++ b/t/uni/parser.t @@ -187,8 +187,12 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't"; # tests for "Bad name" eval q{ Ｆｏｏ::$bar }; like( $@, qr/Bad name after Ｆｏｏ::/, 'Bad name after Ｆｏｏ::' ); -eval q{ Ｆｏｏ''bar }; -like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' ); +{ + # since ' is no longer usable in symbols, the error is no longer "Bad name" + no warnings "syntax"; # suppress String found where operator expeected + eval q{ Ｆｏｏ''bar }; + like( $@, qr/syntax error at \(eval \d+\) line 1, near \"Ｆｏｏ\'\'/, 'Syntax error for Ｆｏｏ\'' ); +} { no warnings 'utf8'; diff --git a/t/uni/stash.t b/t/uni/stash.t index a069aa111e23..7bfdc6cac3c5 100644 --- a/t/uni/stash.t +++ b/t/uni/stash.t @@ -13,7 +13,7 @@ BEGIN { use utf8; use open qw( :utf8 :std ); -plan( tests => 49 ); +plan( tests => 48 ); #These come from op/my_stash.t { @@ -283,8 +283,4 @@ plan( tests => 49 ); ok eval { Bèàr::::bàz() }, 'packages ending with :: are self-consistent'; } - - # [perl #88138] ' not equivalent to :: before a null - ${"à'\0b"} = "c"; - is ${"à::\0b"}, "c", "' is equivalent to :: before a null"; } diff --git a/t/uni/variables.t b/t/uni/variables.t index 2c18951a1a26..c5284de3e9f5 100644 --- a/t/uni/variables.t +++ b/t/uni/variables.t @@ -14,7 +14,7 @@ use utf8; use open qw( :utf8 :std ); no warnings qw(misc reserved); -plan (tests => 66880); +plan (tests => 66879); # ${single:colon} should not be treated as a simple variable, but as a # block with a label inside. @@ -35,16 +35,11 @@ plan (tests => 66880); ); } -# ${yadda'etc} and ${yadda::etc} should both work under strict +# and ${yadda::etc} should both work under strict { local $@; eval q; is($@, '', q<${package::var} works>); - - no warnings qw(syntax deprecated); - local $@; - eval q; - is($@, '', q<...as does ${package'var}>); } # The first character in ${...} should respect the rules diff --git a/toke.c b/toke.c index 352998759021..8a0bd8cdfc3b 100644 --- a/toke.c +++ b/toke.c @@ -2290,7 +2290,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) if ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || (allow_pack && *s == ':' && s[1] == ':') ) { - s = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len, allow_pack); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len); if (check_keyword) { char *s2 = PL_tokenbuf; STRLEN len2 = len; @@ -4829,7 +4829,7 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv) return *s == '(' ? METHCALL : METHCALL0; } - s = scan_word6(s, tmpbuf, sizeof tmpbuf, TRUE, &len, FALSE); + s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); /* start is the beginning of the possible filehandle/object, * and s is the end of it * tmpbuf is a copy of it (but with single quotes as double colons) @@ -5278,7 +5278,7 @@ yyl_sigvar(pTHX_ char *s) /* read var name, including sigil, into PL_tokenbuf */ PL_tokenbuf[0] = sigil; parse_ident(&s, &dest, dest + sizeof(PL_tokenbuf) - 1, - 0, cBOOL(UTF), FALSE, FALSE); + 0, cBOOL(UTF), FALSE); *dest = '\0'; assert(PL_tokenbuf[1]); /* we have a variable name */ } @@ -5515,7 +5515,7 @@ yyl_dollar(pTHX_ char *s) char tmpbuf[sizeof PL_tokenbuf]; int t2; STRLEN len; - scan_word6(s, tmpbuf, sizeof tmpbuf, TRUE, &len, FALSE); + scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); if ((t2 = keyword(tmpbuf, len, 0))) { /* binary operators exclude handle interpretations */ switch (t2) { @@ -5581,13 +5581,11 @@ yyl_sub(pTHX_ char *s, const int key) PL_parser->sig_seen = FALSE; if ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) - || *s == '\'' || (*s == ':' && s[1] == ':')) { PL_expect = XATTRBLOCK; - d = scan_word6(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE, - &len, TRUE); + d = scan_word(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE, &len); if (key == KEY_format) format_name = S_newSV_maybe_utf8(aTHX_ s, d - s); *PL_tokenbuf = '&'; @@ -6181,7 +6179,7 @@ yyl_colon(pTHX_ char *s) I32 tmp; SV *sv; STRLEN len; - char *d = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); + char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len, 0))) { if (tmp < 0) tmp = -tmp; switch (tmp) { @@ -6360,8 +6358,8 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack) } if (d < PL_bufend && isIDFIRST_lazy_if_safe(d, PL_bufend, UTF)) { STRLEN len; - d = scan_word6(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, - FALSE, &len, FALSE); + d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, + FALSE, &len); while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; if (*d == '}') { @@ -7208,7 +7206,7 @@ yyl_foreach(pTHX_ char *s) /* skip optional package name, as in "for my abc $x (..)" */ if (UNLIKELY(isIDFIRST_lazy_if_safe(p, PL_bufend, UTF))) { STRLEN len; - p = scan_word6(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len, TRUE); + p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); p = skipspace(p); paren_is_valid = FALSE; } @@ -7237,8 +7235,8 @@ yyl_do(pTHX_ char *s, I32 orig_keyword) char *d; STRLEN len; *PL_tokenbuf = '&'; - d = scan_word6(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, - 1, &len, TRUE); + d = scan_word(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, + 1, &len); if (len && memNEs(PL_tokenbuf+1, len, "CORE") && !keyword(PL_tokenbuf + 1, len, 0)) { SSize_t off = s-SvPVX(PL_linestr); @@ -7273,7 +7271,7 @@ yyl_my(pTHX_ char *s, I32 my) s = skipspace(s); if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { STRLEN len; - s = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len, TRUE); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (memEQs(PL_tokenbuf, len, "sub")) return yyl_sub(aTHX_ s, my); PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len); @@ -7743,18 +7741,17 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c) /* Get the rest if it looks like a package qualifier */ - if (*s == '\'' || (*s == ':' && s[1] == ':')) { + if (*s == ':' && s[1] == ':') { STRLEN morelen; - s = scan_word6(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, - TRUE, &morelen, TRUE); + s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, + TRUE, &morelen); if (no_op_error) { no_op("Bareword",s); no_op_error = FALSE; } if (!morelen) - Perl_croak(aTHX_ "Bad name after %" UTF8f "%s", - UTF8fARG(UTF, len, PL_tokenbuf), - *s == '\'' ? "'" : "::"); + Perl_croak(aTHX_ "Bad name after %" UTF8f "::", + UTF8fARG(UTF, len, PL_tokenbuf)); len += morelen; pkgname = 1; } @@ -8497,7 +8494,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct s = skipspace(s); if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { const char *t; - char *d = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); + char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); for (t=d; isSPACE(*t);) t++; if ( *t && memCHRs("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) @@ -8938,18 +8935,17 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct static int yyl_key_core(pTHX_ char *s, STRLEN len, struct code c) { - I32 key = 0; I32 orig_keyword = 0; STRLEN olen = len; char *d = s; s += 2; - s = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); - if ((*s == ':' && s[1] == ':') - || (!(key = keyword(PL_tokenbuf, len, 1)) && *s == '\'')) + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); + if (*s == ':' && s[1] == ':') { Copy(PL_bufptr, PL_tokenbuf, olen, char); return yyl_just_a_word(aTHX_ d, olen, 0, c); } + I32 key = keyword(PL_tokenbuf, len, 1); if (!key) Perl_croak(aTHX_ "CORE::%" UTF8f " is not a keyword", UTF8fARG(UTF, len, PL_tokenbuf)); @@ -9022,7 +9018,7 @@ yyl_keylookup(pTHX_ char *s, GV *gv) c.gv = gv; PL_bufptr = s; - s = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); /* Some keywords can be followed by any delimiter, including ':' */ anydelim = word_takes_any_delimiter(PL_tokenbuf, len); @@ -10353,10 +10349,8 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, PERL_STATIC_INLINE void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, - bool is_utf8, bool check_dollar, bool tick_warn) + bool is_utf8, bool check_dollar) { - int saw_tick = 0; - const char *olds = *s; PERL_ARGS_ASSERT_PARSE_IDENT; while (*s < PL_bufend) { @@ -10383,15 +10377,6 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, *(*d)++ = *(*s)++; } while (isWORDCHAR_A(**s) && *d < e); } - else if ( allow_package - && **s == '\'' - && isIDFIRST_lazy_if_safe((*s)+1, PL_bufend, is_utf8)) - { - *(*d)++ = ':'; - *(*d)++ = ':'; - (*s)++; - saw_tick++; - } else if (allow_package && **s == ':' && (*s)[1] == ':' /* Disallow things like Foo::$bar. For the curious, this is * the code path that triggers the "Bad name after" warning @@ -10404,66 +10389,24 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, else break; } - if (UNLIKELY(saw_tick && tick_warn && ckWARN2_d(WARN_SYNTAX, WARN_DEPRECATED__APOSTROPHE_AS_PACKAGE_SEPARATOR))) { - if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) { - char *this_d; - char *d2; - Newx(this_d, *s - olds + saw_tick + 2, char); /* +2 for $# */ - d2 = this_d; - SAVEFREEPV(this_d); - - Perl_warner(aTHX_ packWARN2(WARN_SYNTAX, WARN_DEPRECATED__APOSTROPHE_AS_PACKAGE_SEPARATOR), - "Old package separator used in string"); - if (olds[-1] == '#') - *d2++ = olds[-2]; - *d2++ = olds[-1]; - while (olds < *s) { - if (*olds == '\'') { - *d2++ = '\\'; - *d2++ = *olds++; - } - else - *d2++ = *olds++; - } - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "\t(Did you mean \"%" UTF8f "\" instead?)\n", - UTF8fARG(is_utf8, d2-this_d, this_d)); - } - else { - Perl_warner(aTHX_ packWARN2(WARN_SYNTAX, WARN_DEPRECATED__APOSTROPHE_AS_PACKAGE_SEPARATOR), - "Old package separator \"'\" deprecated"); - } - } return; } -/* Returns a NUL terminated string, with the length of the string written to - *slp - - scan_word6() may be removed once ' in names is removed. - */ char * -Perl_scan_word6(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp, bool warn_tick) +Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) { + PERL_ARGS_ASSERT_SCAN_WORD; + char *d = dest; char * const e = d + destlen - 3; /* two-character token, ending NUL */ bool is_utf8 = cBOOL(UTF); - PERL_ARGS_ASSERT_SCAN_WORD6; - - parse_ident(&s, &d, e, allow_package, is_utf8, TRUE, warn_tick); + parse_ident(&s, &d, e, allow_package, is_utf8, TRUE); *d = '\0'; *slp = d - dest; return s; } -char * -Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) -{ - PERL_ARGS_ASSERT_SCAN_WORD; - return scan_word6(s, dest, destlen, allow_package, slp, FALSE); -} - /* scan s and extract an identifier ($var) from it if possible * into dest. * XXX: This function has subtle implications on parsing, and @@ -10499,7 +10442,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) Perl_croak(aTHX_ ident_var_zero_multi_digit); } else { /* See if it is a "normal" identifier */ - parse_ident(&s, &d, e, 1, is_utf8, FALSE, TRUE); + parse_ident(&s, &d, e, 1, is_utf8, FALSE); } *d = '\0'; d = dest; @@ -10624,7 +10567,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) (the later check for } being at the expected point will trap cases where this doesn't pan out.) */ d += is_utf8 ? UTF8SKIP(d) : 1; - parse_ident(&s, &d, e, 1, is_utf8, TRUE, TRUE); + parse_ident(&s, &d, e, 1, is_utf8, TRUE); *d = '\0'; } else { /* caret word: ${^Foo} ${^CAPTURE[0]} */ @@ -11571,7 +11514,7 @@ S_scan_inputsymbol(pTHX_ char *start) if (*d == '$' && d[1]) d++; /* allow or */ - while (isWORDCHAR_lazy_if_safe(d, e, UTF) || *d == '\'' || *d == ':') { + while (isWORDCHAR_lazy_if_safe(d, e, UTF) || *d == ':') { d += UTF ? UTF8SKIP(d) : 1; } @@ -13919,7 +13862,7 @@ Perl_parse_label(pTHX_ U32 flags) t = s = PL_bufptr; if (!isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) goto no_label; - t = scan_word6(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen, FALSE); + t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen); if (word_takes_any_delimiter(s, wlen)) goto no_label; bufptr_pos = s - SvPVX(PL_linestr);