diff --git a/embed.fnc b/embed.fnc index 3821ec91503a..60c27c6565e3 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3366,7 +3366,8 @@ EXpx |char * |scan_word |NN char *s \ |NN char *dest \ |STRLEN destlen \ |int allow_package \ - |NN STRLEN *slp + |NN STRLEN *slp \ + |bool warn_tick EXpxR |char * |skipspace_flags|NN char *s \ |U32 flags EdXxp |bool |validate_proto |NN SV *name \ diff --git a/embed.h b/embed.h index 732fc53d8180..2ef81b95dc4f 100644 --- a/embed.h +++ b/embed.h @@ -1697,7 +1697,7 @@ # define reg_temp_copy(a,b) Perl_reg_temp_copy(aTHX_ a,b) # 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_word(a,b,c,d,e,f) Perl_scan_word(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/pod/perldiag.pod b/pod/perldiag.pod index 5e8cfedec587..e44f2312c7bc 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -4517,13 +4517,21 @@ 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 + +(W deprecated, 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.40. + =item Old package separator used in string -(W syntax) You used the old package separator, "'", in a variable +(W deprecated, 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.40. + =item %s() on unopened %s (W unopened) An I/O operation was attempted on a filehandle that was diff --git a/proto.h b/proto.h index 0efbfeaeb662..286c2e18a789 100644 --- a/proto.h +++ b/proto.h @@ -4155,7 +4155,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char * const e, SV *sv); assert(s); assert(e); assert(sv) PERL_CALLCONV char * -Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp); +Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp, bool warn_tick); #define PERL_ARGS_ASSERT_SCAN_WORD \ assert(s); assert(dest); assert(slp) diff --git a/t/comp/package.t b/t/comp/package.t index fa28868f9fcb..7b19513bddf2 100644 --- a/t/comp/package.t +++ b/t/comp/package.t @@ -1,5 +1,10 @@ #!./perl +BEGIN { + @INC = qw(. ../lib); + chdir 't' if -d 't'; +} + print "1..14\n"; $blurfl = 123; @@ -13,11 +18,14 @@ $bar = 4; { package ABC; + no warnings qw(syntax deprecated); $blurfl = 5; $main'a = $'b; } - -$ABC'dyick = 6; +{ + no warnings qw(syntax deprecated); + $ABC'dyick = 6; +} $xyz = 2; @@ -28,10 +36,13 @@ $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:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n"; + print $xyz eq 'ABC:BEGIN: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"; +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"; +} package ABC; diff --git a/t/comp/parser.t b/t/comp/parser.t index 8f4a484756f2..a2a432d8f9e5 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -367,11 +367,14 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' ); is(defined &zlonk, '', 'but no body defined'); } -# [perl #113016] CORE::print::foo -sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate -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"; +{ + no warnings; + # [perl #113016] CORE::print::foo + sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate + 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"; +} # bug #71748 eval q{ @@ -448,8 +451,10 @@ END eval 's/${<SUPER::method('whatever'); ::is $ret[0], $o, 'object passed to SUPER::method'; ::is $ret[1], 'whatever', 'argument passed to SUPER::method'; - @ret = $o->SUPER'method('whatever'); + { + 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; diff --git a/t/op/ref.t b/t/op/ref.t index 77b5193a162a..d53fac4dbc0c 100644 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -265,8 +265,10 @@ is (join('', sort values %$anonhash2), 'BARXYZ'); # Test bless operator. package MYHASH; - -$object = bless $main'anonhash2; +{ + no warnings qw(syntax deprecated); + $object = bless $main'anonhash2; +} main::is (ref $object, 'MYHASH'); main::is ($object->{ABC}, 'XYZ'); @@ -290,7 +292,10 @@ sub mymethod { $string = "bad"; $object = "foo"; $string = "good"; -$main'anonhash2 = "foo"; +{ + no warnings qw(syntax deprecated); + $main'anonhash2 = "foo"; +} $string = ""; DESTROY { @@ -307,7 +312,10 @@ package OBJ; @ISA = ('BASEOBJ'); -$main'object = bless {FOO => 'foo', BAR => 'bar'}; +{ + no warnings qw(syntax deprecated); + $main'object = bless {FOO => 'foo', BAR => 'bar'}; +} package main; @@ -320,10 +328,13 @@ is ($object->doit("BAR"), 'bar'); $foo = doit $object "FOO"; main::is ($foo, 'foo'); -sub BASEOBJ'doit { - local $ref = shift; - die "Not an OBJ" unless ref $ref eq 'OBJ'; - $ref->{shift()}; +{ + no warnings qw(syntax deprecated); + 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 760def11d9b4..1a429f13c7b5 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -237,6 +237,7 @@ eval { @b = sort twoface 4,1 }; cmp_ok(substr($@,0,4), 'eq', 'good', 'twoface eval'); eval <<'CODE'; + no warnings qw(deprecated syntax); my @result = sort main'Backwards 'one', 'two'; CODE cmp_ok($@,'eq','',q(old skool package)); diff --git a/t/op/stash_parse_gv.t b/t/op/stash_parse_gv.t index bd9e95cf37b6..9e143d979e15 100644 --- a/t/op/stash_parse_gv.t +++ b/t/op/stash_parse_gv.t @@ -23,7 +23,7 @@ foreach my $t (@tests) { my ( $sub, $name ) = @$t; fresh_perl_is( - qq[sub $sub { print qq[ok\n]} &{"$sub"}; my \$d = defined *{"foo$sub"} ], + qq[no warnings qw(syntax deprecated); sub $sub { print qq[ok\n]} &{"$sub"}; my \$d = defined *{"foo$sub"} ], q[ok], { switches => ['-w'] }, $name diff --git a/t/uni/package.t b/t/uni/package.t index 1480ebdf1fc4..84d3ea32789f 100644 --- a/t/uni/package.t +++ b/t/uni/package.t @@ -34,16 +34,23 @@ ok 1, "sanity check. If we got this far, UTF-8 in package names is legal."; $ㄅĽuṞfⳐ = 5; } - $압Ƈ'd읯ⱪ = 6; #' - + { + no warnings qw(syntax deprecated); + $압Ƈ'd읯ⱪ = 6; #' + } + $ꑭʑ = 2; $ꑭʑ = join(':', sort(keys %ꑭʑ::)); $압Ƈ = join(':', sort(keys %압Ƈ::)); - ::is $ꑭʑ, 'bar:ニュー:ꑭʑ:압Ƈ', "comp/stash.t test 1"; + ::is $ꑭʑ, 'BEGIN:bar:ニュー:ꑭʑ:압Ƈ', "comp/stash.t test 1"; ::is $압Ƈ, "d읯ⱪ:ㄅĽuṞfⳐ", "comp/stash.t test 2"; - ::is $main'ㄅĽuṞfⳐ, 123, "comp/stash.t test 3"; + + { + no warnings qw(syntax deprecated); + ::is $main'ㄅĽuṞfⳐ, 123, "comp/stash.t test 3"; + } package 압Ƈ; diff --git a/t/uni/variables.t b/t/uni/variables.t index a8a67684f045..2c18951a1a26 100644 --- a/t/uni/variables.t +++ b/t/uni/variables.t @@ -41,6 +41,7 @@ plan (tests => 66880); eval q; is($@, '', q<${package::var} works>); + no warnings qw(syntax deprecated); local $@; eval q; is($@, '', q<...as does ${package'var}>); diff --git a/toke.c b/toke.c index ffb9201147d6..c4585a528c3b 100644 --- a/toke.c +++ b/toke.c @@ -2258,7 +2258,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_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len, allow_pack); if (check_keyword) { char *s2 = PL_tokenbuf; STRLEN len2 = len; @@ -4670,7 +4670,7 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv) return *s == '(' ? METHCALL : METHCALL0; } - s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); + s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len, FALSE); /* 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) @@ -5299,7 +5299,7 @@ yyl_dollar(pTHX_ char *s) if (isIDFIRST_lazy_if_safe(t, PL_bufend, UTF)) { STRLEN len; t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, - &len); + &len, TRUE); while (isSPACE(*t)) t++; if ( *t == ';' @@ -5332,7 +5332,7 @@ yyl_dollar(pTHX_ char *s) char tmpbuf[sizeof PL_tokenbuf]; int t2; STRLEN len; - scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); + scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len, FALSE); if ((t2 = keyword(tmpbuf, len, 0))) { /* binary operators exclude handle interpretations */ switch (t2) { @@ -5401,7 +5401,7 @@ yyl_sub(pTHX_ char *s, const int key) PL_expect = XATTRBLOCK; d = scan_word(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE, - &len); + &len, TRUE); if (key == KEY_format) format_name = S_newSV_maybe_utf8(aTHX_ s, d - s); *PL_tokenbuf = '&'; @@ -5980,7 +5980,7 @@ yyl_colon(pTHX_ char *s) I32 tmp; SV *sv; STRLEN len; - char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); + char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len, 0))) { if (tmp < 0) tmp = -tmp; switch (tmp) { @@ -6161,7 +6161,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack) if (d < PL_bufend && isIDFIRST_lazy_if_safe(d, PL_bufend, UTF)) { STRLEN len; d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, - FALSE, &len); + FALSE, &len, FALSE); while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; if (*d == '}') { @@ -7006,7 +7006,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_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); + p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len, TRUE); p = skipspace(p); paren_is_valid = FALSE; } @@ -7038,7 +7038,7 @@ yyl_do(pTHX_ char *s, I32 orig_keyword) STRLEN len; *PL_tokenbuf = '&'; d = scan_word(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, - 1, &len); + 1, &len, TRUE); if (len && memNEs(PL_tokenbuf+1, len, "CORE") && !keyword(PL_tokenbuf + 1, len, 0)) { SSize_t off = s-SvPVX(PL_linestr); @@ -7073,7 +7073,7 @@ yyl_my(pTHX_ char *s, I32 my) s = skipspace(s); if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { STRLEN len; - s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len, TRUE); if (memEQs(PL_tokenbuf, len, "sub")) return yyl_sub(aTHX_ s, my); PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len); @@ -7546,7 +7546,7 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c) if (*s == '\'' || (*s == ':' && s[1] == ':')) { STRLEN morelen; s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, - TRUE, &morelen); + TRUE, &morelen, TRUE); if (no_op_error) { no_op("Bareword",s); no_op_error = FALSE; @@ -8263,7 +8263,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_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); + char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); for (t=d; isSPACE(*t);) t++; if ( *t && memCHRs("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) @@ -8705,7 +8705,7 @@ yyl_key_core(pTHX_ char *s, STRLEN len, struct code c) STRLEN olen = len; char *d = s; s += 2; - s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); if ((*s == ':' && s[1] == ':') || (!(key = keyword(PL_tokenbuf, len, 1)) && *s == '\'')) { @@ -8784,7 +8784,7 @@ yyl_keylookup(pTHX_ char *s, GV *gv) c.gv = gv; PL_bufptr = s; - s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); + s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE); /* Some keywords can be followed by any delimiter, including ':' */ anydelim = word_takes_any_delimiter(PL_tokenbuf, len); @@ -10156,29 +10156,35 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, else break; } - if (UNLIKELY(tick_warn && saw_tick && PL_lex_state == LEX_INTERPNORMAL - && !PL_lex_brackets && ckWARN(WARN_SYNTAX))) { - 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_ packWARN(WARN_SYNTAX), - "Old package separator used in string"); - if (olds[-1] == '#') - *d2++ = olds[-2]; - *d2++ = olds[-1]; - while (olds < *s) { - if (*olds == '\'') { - *d2++ = '\\'; - *d2++ = *olds++; + if (UNLIKELY(saw_tick && tick_warn && ckWARN2_d(WARN_SYNTAX, WARN_DEPRECATED))) { + 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), + "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++; } - 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), + "Old package separator \"'\" deprecated"); } - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "\t(Did you mean \"%" UTF8f "\" instead?)\n", - UTF8fARG(is_utf8, d2-this_d, this_d)); } return; } @@ -10187,7 +10193,7 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, *slp */ char * -Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) +Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp, bool warn_tick) { char *d = dest; char * const e = d + destlen - 3; /* two-character token, ending NUL */ @@ -10195,7 +10201,7 @@ Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STR PERL_ARGS_ASSERT_SCAN_WORD; - parse_ident(&s, &d, e, allow_package, is_utf8, TRUE, FALSE); + parse_ident(&s, &d, e, allow_package, is_utf8, TRUE, warn_tick); *d = '\0'; *slp = d - dest; return s; @@ -13678,7 +13684,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_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen); + t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen, FALSE); if (word_takes_any_delimiter(s, wlen)) goto no_label; bufptr_pos = s - SvPVX(PL_linestr);