In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d1d15184c41c6ad4f16829561163cd118e5ae917?hp=9b7a5066c959acc331302e11abdc5e60a5cda5b4>
- Log ----------------------------------------------------------------- commit d1d15184c41c6ad4f16829561163cd118e5ae917 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 16:04:18 2009 +0100 Enable deprecation warnings by default. M gv.c M handy.h M op.c M pod/perldiag.pod M pod/perlvar.pod M pp_sys.c M regcomp.c M t/lib/warnings/op M t/lib/warnings/toke commit 43b3daf05d64926950dcc26b6a3e77b7c8f513da Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 16:02:05 2009 +0100 locked is deprecated, so use :lvalue instead. M cpan/AutoLoader/t/02AutoSplit.t commit af224ca80759294e384971bba25264ff216c7223 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:59:58 2009 +0100 Can't use C<shift INC> to avoid @ in a commandline now, so use eval and octal. M lib/Config.t commit f652f7a555220290c8a3a6c757a06871483f14f9 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:37:12 2009 +0100 shift with barewords is deprecated, so this test from perl 1 needs updating. M t/op/unshift.t commit 35ea4f2c0b9de07953e4b43ee1e2f6b8ec89f25c Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:36:14 2009 +0100 push and pop on barewords are deprecated, so need no warnings 'deprecated'; M t/op/push.t commit 3963d30b5a2dc4d265ac265e8db15801366a507f Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:35:15 2009 +0100 Opening dirhandle DIR also as a file needs no warnings 'deprecated'; M t/op/stat.t commit 140d27a472ded936ea3bf0616e64be64bc105edd Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:33:16 2009 +0100 defined @array and defined %hash need no warnings 'deprecated'; M t/op/undef.t commit 4521bb0671e9410465c861eb64d36b312a967b53 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:32:03 2009 +0100 localisation of $[ is deprecated, so needs no warnings 'deprecated'; M t/op/local.t commit d152a4c4e9147bb67eee2f34c9e64eeb8fdbd1b8 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 16:39:16 2009 +0100 :locked is deprecated, so use :lvalue instead. M t/op/exists_sub.t commit eb81740c724e07e132ae8122503daaf89eba703b Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:26:32 2009 +0100 Tests for barewords and hash operators need no warnings 'deprecated'; M t/op/each.t commit 96ccdd02f19e8749808107cd642a6001ab8033fc Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:25:03 2009 +0100 do subname() is deprecated, so tests for it need no warnings 'deprecated'; M t/op/do.t commit bb19cdcde94e10abb00ef5f784a633998ecc79a9 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:16:53 2009 +0100 do subname() is deprecated, so update this hunk of test dating from perl 1. M t/op/chop.t commit 136c2a5ed8214b1a6791e11379cbee1edd6c291c Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:16:16 2009 +0100 Bracket deprecated features with no warnings 'deprecated'; M t/op/array.t commit 2a70d4f61c76d61d938271d96ddac9f5537a132b Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:14:12 2009 +0100 do subname() is deprecated, so this test from perl 3 needs updating. M t/cmd/switch.t commit a026e652f130da8b58678a660c78f33c386027aa Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 15:10:40 2009 +0100 Move tests for $[ from comp/hints.t to op/array_base.t Tests in t/comp/ are too early to rely on pragmata working. M MANIFEST M t/comp/hints.aux M t/comp/hints.t A t/op/array_base.aux M t/op/array_base.t commit 24d0fc42f3cde6d97ff49e299caa014144e156ef Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 14:33:38 2009 +0100 Move tests for $[ from comp/parser.t to op/array_base.t Tests in t/comp/ are too early to rely on pragmata working. M MANIFEST M t/comp/parser.t A t/op/array_base.t commit 065f14eb9d944e9b3262cfef1909b7c914642623 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 13:56:06 2009 +0100 do subname() is deprecated, so this test from perl 1 needs updating. M t/comp/decl.t commit f3365a56c42f2f31eed84ad55632f9786ee09044 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 13:44:50 2009 +0100 Move the test for the deprecated feature <<; out of t/base/lext.t Tests in base can't utilise pragmata, specifically no warnings 'deprecated'; M MANIFEST M t/base/lex.t A t/op/lex.t commit f560054f038f9369201fb083944780fa1a0ad949 Author: Nicholas Clark <[email protected]> Date: Tue Oct 13 13:32:50 2009 +0100 Add no warnings 'deprecated' to a test that assigns to $[ M t/op/index.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 3 + cpan/AutoLoader/t/02AutoSplit.t | 8 ++-- gv.c | 6 +- handy.h | 2 +- lib/Config.t | 5 +- op.c | 20 ++++---- pod/perldiag.pod | 6 +- pod/perlvar.pod | 3 +- pp_sys.c | 10 ++-- regcomp.c | 2 +- t/base/lex.t | 9 ++-- t/cmd/switch.t | 36 +++++++------- t/comp/decl.t | 8 ++-- t/comp/hints.aux | 3 +- t/comp/hints.t | 37 +++----------- t/comp/parser.t | 36 +------------- t/lib/warnings/op | 28 ++++------ t/lib/warnings/toke | 20 +++---- t/op/array.t | 11 ++++- t/{comp/hints.aux => op/array_base.aux} | 0 t/op/array_base.t | 82 +++++++++++++++++++++++++++++++ t/op/chop.t | 2 +- t/op/do.t | 20 ++++++-- t/op/each.t | 14 ++++-- t/op/exists_sub.t | 2 +- t/op/index.t | 3 +- t/op/lex.t | 22 ++++++++ t/op/local.t | 1 + t/op/push.t | 10 +++- t/op/stat.t | 14 ++++-- t/op/undef.t | 2 + t/op/unshift.t | 4 +- 32 files changed, 259 insertions(+), 170 deletions(-) copy t/{comp/hints.aux => op/array_base.aux} (100%) create mode 100644 t/op/array_base.t create mode 100644 t/op/lex.t diff --git a/MANIFEST b/MANIFEST index 14a3a54..8b0f5d8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4311,6 +4311,8 @@ t/op/anonsub.t See if anonymous subroutines work t/op/append.t See if . works t/op/args.t See if operations on @_ work t/op/arith.t See if arithmetic works +t/op/array_base.aux Auxiliary file for the $[ test +t/op/array_base.t Tests for the $[, which is deprecated t/op/array.t See if array operations work t/op/assignwarn.t See if OP= operators warn correctly for undef targets t/op/attrhand.t See if attribute handlers work @@ -4376,6 +4378,7 @@ t/op/lc.t See if lc, uc, lcfirst, ucfirst, quotemeta work t/op/lc_user.t See if user-defined lc et alia work t/op/length.t See if length works t/op/lex_assign.t See if ops involving lexicals or pad temps work +t/op/lex.t Tests too complex for t/base/lex.t t/op/lfs.t See if large files work for perlio t/op/list.t See if array lists work t/op/localref.t See if local ${deref} works diff --git a/cpan/AutoLoader/t/02AutoSplit.t b/cpan/AutoLoader/t/02AutoSplit.t index c652562..f220a76 100644 --- a/cpan/AutoLoader/t/02AutoSplit.t +++ b/cpan/AutoLoader/t/02AutoSplit.t @@ -247,8 +247,8 @@ package Yet::Another::AutoSplit; sub testtesttesttest4_1 ($) { "another test 4"; } sub testtesttesttest4_2 ($$) { "another duplicate test 4"; } package Yet::More::Attributes; -sub test_a1 ($) : locked :locked { 1; } -sub test_a2 : locked { 1; } +sub test_a1 ($) : lvalue :lvalue { 1; } +sub test_a2 : lvalue { 1; } # And that was all it has. You were expected to manually inspect the output ## Get Warning: AutoSplit had to create top-level *DIR* unexpectedly. @@ -280,8 +280,8 @@ sub test2\s*\(\$\$\); sub test3\s*\(\$\$\$\); sub testtesttesttest4_1\s*\(\$\); sub testtesttesttest4_2\s*\(\$\$\); -sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*; -sub test_a2\s*:\s*locked\s*; +sub test_a1\s*\(\$\)\s*:\s*lvalue\s*:\s*lvalue\s*; +sub test_a2\s*:\s*lvalue\s*; ## Tests is (*MOD*::test1 (1), 'test 1'); is (*MOD*::test2 (1,2), 'test 2'); diff --git a/gv.c b/gv.c index e967f90..22af274 100644 --- a/gv.c +++ b/gv.c @@ -729,9 +729,9 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) */ if (!method && (GvCVGEN(gv) || GvSTASH(gv) != stash) ) - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), - "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", - packname, (int)len, name); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", + packname, (int)len, name); if (CvISXSUB(cv)) { /* rather than lookup/init $AUTOLOAD here diff --git a/handy.h b/handy.h index 6c049cb..d291eb6 100644 --- a/handy.h +++ b/handy.h @@ -906,7 +906,7 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe shortcut macro defined without -DPERL_CORE. Neither codesearch.google.com nor CPAN::Unpack show any users outside the core. */ #ifdef PERL_CORE -# define deprecate(s) Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of " s " is deprecated") +# define deprecate(s) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Use of " s " is deprecated") #endif /* diff --git a/lib/Config.t b/lib/Config.t index da84b78..922f826 100644 --- a/lib/Config.t +++ b/lib/Config.t @@ -242,11 +242,12 @@ foreach my $pain ($first, @virtual) { # Check that config entries appear correctly in @INC # TestInit.pm has probably already messed with our @INC # This little bit of evil is to avoid a @ in the program, in case it confuses -# shell 1 liners. Perl 1 rules. +# shell 1 liners. We used to use a perl 1-ism, until that was deprecated, so +# now some octal in an eval. my ($path, $ver, @orig_inc) = split /\n/, runperl (nolib=>1, - prog=>'print qq{$^X\n$]\n}; print qq{$_\n} while $_ = shift INC'); + prog=>'print qq{$_\n} foreach $^X, $], eval qq{\100INC}'); die "This perl is $] at $^X; other perl is $ver (at $path) " . '- failed to find this perl' unless $] eq $ver; diff --git a/op.c b/op.c index 796bec3..d563282 100644 --- a/op.c +++ b/op.c @@ -4571,8 +4571,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) && o2->op_private & OPpLVAL_INTRO && !(o2->op_private & OPpPAD_STATE)) { - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), - "Deprecated use of my() in false conditional"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Deprecated use of my() in false conditional"); } *otherp = NULL; @@ -6265,7 +6265,7 @@ Perl_newAVREF(pTHX_ OP *o) return o; } else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) { - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Using an array as a reference is deprecated"); } return newUNOP(OP_RV2AV, 0, scalar(o)); @@ -6292,7 +6292,7 @@ Perl_newHVREF(pTHX_ OP *o) return o; } else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) { - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Using a hash as a reference is deprecated"); } return newUNOP(OP_RV2HV, 0, scalar(o)); @@ -6845,7 +6845,7 @@ Perl_ck_fun(pTHX_ OP *o) { OP * const newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVAV) )); - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Array @%"SVf" missing the @ in argument %"IVdf" of %s()", SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); #ifdef PERL_MAD @@ -6867,7 +6867,7 @@ Perl_ck_fun(pTHX_ OP *o) { OP * const newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVHV) )); - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()", SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); #ifdef PERL_MAD @@ -7215,9 +7215,9 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ break; /* Globals via GV can be undef */ case OP_PADAV: case OP_AASSIGN: /* Is this a good idea? */ - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "defined(@array) is deprecated"); - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "\t(Maybe you should just omit the defined()?)\n"); break; case OP_RV2HV: @@ -7227,9 +7227,9 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ */ break; /* Globals via GV can be undef */ case OP_PADHV: - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "defined(%%hash) is deprecated"); - Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED), + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "\t(Maybe you should just omit the defined()?)\n"); break; default: diff --git a/pod/perldiag.pod b/pod/perldiag.pod index ab9a947..255eb53 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -8,7 +8,7 @@ These messages are classified as follows (listed in increasing order of desperation): (W) A warning (optional). - (D) A deprecation (optional). + (D) A deprecation (enabled by default). (S) A severe warning (enabled by default). (F) A fatal error (trappable). (P) An internal error you should never see (trappable). @@ -2191,7 +2191,7 @@ neither as a system call or an ioctl call (SIOCATMARK). =item $* is no longer supported -(S deprecated, syntax) The special variable C<$*>, deprecated in older perls, has +(D deprecated, syntax) The special variable C<$*>, deprecated in older perls, has been removed as of 5.9.0 and is no longer supported. In previous versions of perl the use of C<$*> enabled or disabled multi-line matching within a string. @@ -2201,7 +2201,7 @@ expressions behaved as if they were written using C</m>.) =item $# is no longer supported -(S deprecated, syntax) The special variable C<$#>, deprecated in older perls, has +(D deprecated, syntax) The special variable C<$#>, deprecated in older perls, has been removed as of 5.9.3 and is no longer supported. You should use the printf/sprintf functions instead. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index f2e29e1..834a880 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -1038,8 +1038,7 @@ subscripting and when evaluating the index() and substr() functions. As of release 5 of Perl, assignment to C<$[> is treated as a compiler directive, and cannot influence the behavior of any other file. (That's why you can only assign compile-time constants to it.) Its -use is deprecated, and will trigger a warning (if the deprecation -L<warnings> category is enabled. You did C<use warnings>, right?) +use is deprecated, and by default will trigger a warning. Note that, unlike other compile-time directives (such as L<strict>), assignment to C<$[> can be seen from outer lexical scopes in the same file. diff --git a/pp_sys.c b/pp_sys.c index 4c00651..d3430d1 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -522,8 +522,9 @@ PP(pp_open) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; if (IoDIRP(io)) - Perl_ck_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), - "Opening dirhandle %s also as a file", GvENAME(gv)); + Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), + "Opening dirhandle %s also as a file", + GvENAME(gv)); mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { @@ -3829,8 +3830,9 @@ PP(pp_open_dir) goto nope; if ((IoIFP(io) || IoOFP(io))) - Perl_ck_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), - "Opening filehandle %s also as a directory", GvENAME(gv)); + Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), + "Opening filehandle %s also as a directory", + GvENAME(gv)); if (IoDIRP(io)) PerlDir_close(IoDIRP(io)); if (!(IoDIRP(io) = PerlDir_open(dirname))) diff --git a/regcomp.c b/regcomp.c index 0f5f81d..5a6ca55 100644 --- a/regcomp.c +++ b/regcomp.c @@ -483,7 +483,7 @@ static const scan_data_t zero_scan_data = #define ckWARNregdep(loc,m) STMT_START { \ const IV offset = loc - RExC_precomp; \ - Perl_ck_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ + Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ m REPORT_LOCATION, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END diff --git a/t/base/lex.t b/t/base/lex.t index 8cadf85..a5d87f6 100644 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -69,10 +69,11 @@ print qq print q<ok 17 >; -print <<; # Yow! -ok 18 - -# previous line intentionally left blank. +print "ok 18 - was the test for the deprecated use of bare << to mean <<\"\"\n"; +#print <<; # Yow! +#ok 18 +# +## previous line intentionally left blank. print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n"; @{[ <<E2 ]} diff --git a/t/cmd/switch.t b/t/cmd/switch.t index 82f417f..4b588d4 100644 --- a/t/cmd/switch.t +++ b/t/cmd/switch.t @@ -17,12 +17,12 @@ sub foo1 { } } -print do foo1(0) == 20 ? "ok 1\n" : "not ok 1\n"; -print do foo1(1) == 1 ? "ok 2\n" : "not ok 2\n"; -print do foo1(2) == 2 ? "ok 3\n" : "not ok 3\n"; -print do foo1(3) == 3 ? "ok 4\n" : "not ok 4\n"; -print do foo1(4) == 4 ? "ok 5\n" : "not ok 5\n"; -print do foo1(5) == 20 ? "ok 6\n" : "not ok 6\n"; +print foo1(0) == 20 ? "ok 1\n" : "not ok 1\n"; +print foo1(1) == 1 ? "ok 2\n" : "not ok 2\n"; +print foo1(2) == 2 ? "ok 3\n" : "not ok 3\n"; +print foo1(3) == 3 ? "ok 4\n" : "not ok 4\n"; +print foo1(4) == 4 ? "ok 5\n" : "not ok 5\n"; +print foo1(5) == 20 ? "ok 6\n" : "not ok 6\n"; sub foo2 { $_ = shift(@_); @@ -38,12 +38,12 @@ sub foo2 { return $_; } -print do foo2(0) == 20 ? "ok 7\n" : "not ok 7\n"; -print do foo2(1) == 1 ? "ok 8\n" : "not ok 8\n"; -print do foo2(2) == 2 ? "ok 9\n" : "not ok 9\n"; -print do foo2(3) == 3 ? "ok 10\n" : "not ok 10\n"; -print do foo2(4) == 4 ? "ok 11\n" : "not ok 11\n"; -print do foo2(5) == 20 ? "ok 12\n" : "not ok 12\n"; +print foo2(0) == 20 ? "ok 7\n" : "not ok 7\n"; +print foo2(1) == 1 ? "ok 8\n" : "not ok 8\n"; +print foo2(2) == 2 ? "ok 9\n" : "not ok 9\n"; +print foo2(3) == 3 ? "ok 10\n" : "not ok 10\n"; +print foo2(4) == 4 ? "ok 11\n" : "not ok 11\n"; +print foo2(5) == 20 ? "ok 12\n" : "not ok 12\n"; sub foo3 { $_ = shift(@_); @@ -65,9 +65,9 @@ sub foo3 { return 40; } -print do foo3(0) == 20 ? "ok 13\n" : "not ok 13\n"; -print do foo3(1) == 1 ? "ok 14\n" : "not ok 14\n"; -print do foo3(2) == 2 ? "ok 15\n" : "not ok 15\n"; -print do foo3(3) == 3 ? "ok 16\n" : "not ok 16\n"; -print do foo3(4) == 4 ? "ok 17\n" : "not ok 17\n"; -print do foo3(5) == 20 ? "ok 18\n" : "not ok 18\n"; +print foo3(0) == 20 ? "ok 13\n" : "not ok 13\n"; +print foo3(1) == 1 ? "ok 14\n" : "not ok 14\n"; +print foo3(2) == 2 ? "ok 15\n" : "not ok 15\n"; +print foo3(3) == 3 ? "ok 16\n" : "not ok 16\n"; +print foo3(4) == 4 ? "ok 17\n" : "not ok 17\n"; +print foo3(5) == 20 ? "ok 18\n" : "not ok 18\n"; diff --git a/t/comp/decl.t b/t/comp/decl.t index a4b898c..5056850 100644 --- a/t/comp/decl.t +++ b/t/comp/decl.t @@ -11,8 +11,8 @@ ok 5 print "1..7\n"; -do one(); -do two(); +one(); +two(); sub two { print "ok 2\n"; @@ -26,10 +26,10 @@ if ($x eq $x) { sub three { print "ok 3\n"; } - do three(); + three(); } -do four(); +four(); $~ = 'one'; write; $~ = 'two'; diff --git a/t/comp/hints.aux b/t/comp/hints.aux index 79b6dee..bb75d7b 100644 --- a/t/comp/hints.aux +++ b/t/comp/hints.aux @@ -1,5 +1,4 @@ -our($ra1, $ri1, $rf1, $rfe1); -$ra1 = $[; +our($ri1, $rf1, $rfe1); BEGIN { $ri1 = $^H; $rf1 = $^H{foo}; $rfe1 = exists($^H{foo}); } 1; diff --git a/t/comp/hints.t b/t/comp/hints.t index f197c6b..f8c6dca 100644 --- a/t/comp/hints.t +++ b/t/comp/hints.t @@ -4,7 +4,7 @@ @INC = '../lib'; -BEGIN { print "1..32\n"; } +BEGIN { print "1..23\n"; } BEGIN { print "not " if exists $^H{foo}; print "ok 1 - \$^H{foo} doesn't exist initially\n"; @@ -93,41 +93,20 @@ BEGIN { } { - $[ = 11; - print +($[ == 11 ? "" : "not "), "ok 17 - setting \$[ affects \$[\n"; - our $t11; BEGIN { $t11 = $^H{'$['} } - print +($t11 == 11 ? "" : "not "), "ok 18 - setting \$[ affects \$^H{'\$['}\n"; - - BEGIN { $^H{'$['} = 22 } - print +($[ == 22 ? "" : "not "), "ok 19 - setting \$^H{'\$['} affects \$[\n"; - our $t22; BEGIN { $t22 = $^H{'$['} } - print +($t22 == 22 ? "" : "not "), "ok 20 - setting \$^H{'\$['} affects \$^H{'\$['}\n"; - - BEGIN { %^H = () } - print +($[ == 0 ? "" : "not "), "ok 21 - clearing \%^H affects \$[\n"; - our $t0; BEGIN { $t0 = $^H{'$['} } - print +($t0 == 0 ? "" : "not "), "ok 22 - clearing \%^H affects \$^H{'\$['}\n"; -} - -{ - $[ = 13; BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; } our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; } - print +($[ == 13 ? "" : "not "), "ok 23 - \$[ correct before require\n"; - print +($ri0 & 0x04000000 ? "" : "not "), "ok 24 - \$^H correct before require\n"; - print +($rf0 eq "z" ? "" : "not "), "ok 25 - \$^H{foo} correct before require\n"; + print +($ri0 & 0x04000000 ? "" : "not "), "ok 17 - \$^H correct before require\n"; + print +($rf0 eq "z" ? "" : "not "), "ok 18 - \$^H{foo} correct before require\n"; our($ra1, $ri1, $rf1, $rfe1); BEGIN { require "comp/hints.aux"; } - print +($ra1 == 0 ? "" : "not "), "ok 26 - \$[ cleared for require\n"; - print +(!($ri1 & 0x04000000) ? "" : "not "), "ok 27 - \$^H cleared for require\n"; - print +(!defined($rf1) && !$rfe1 ? "" : "not "), "ok 28 - \$^H{foo} cleared for require\n"; + print +(!($ri1 & 0x04000000) ? "" : "not "), "ok 19 - \$^H cleared for require\n"; + print +(!defined($rf1) && !$rfe1 ? "" : "not "), "ok 20 - \$^H{foo} cleared for require\n"; our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; } - print +($[ == 13 ? "" : "not "), "ok 29 - \$[ correct after require\n"; - print +($ri2 & 0x04000000 ? "" : "not "), "ok 30 - \$^H correct after require\n"; - print +($rf2 eq "z" ? "" : "not "), "ok 31 - \$^H{foo} correct after require\n"; + print +($ri2 & 0x04000000 ? "" : "not "), "ok 21 - \$^H correct after require\n"; + print +($rf2 eq "z" ? "" : "not "), "ok 22 - \$^H{foo} correct after require\n"; } # Add new tests above this require, in case it fails. @@ -139,7 +118,7 @@ my $result = runperl( stderr => 1 ); print "not " if length $result; -print "ok 32 - double-freeing hints hash\n"; +print "ok 23 - double-freeing hints hash\n"; print "# got: $result\n" if length $result; __END__ diff --git a/t/comp/parser.t b/t/comp/parser.t index d0e7f5d..eed0f18 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -3,7 +3,7 @@ # Checks if the parser behaves correctly in edge cases # (including weird syntax errors) -print "1..112\n"; +print "1..104\n"; sub failed { my ($got, $expected, $name) = @_; @@ -195,16 +195,6 @@ EOF like( $@, qr/syntax error/, "use without body" ); } -# Bug #27024 -{ - # this used to segfault (because $[=1 is optimized away to a null block) - my $x; - $[ = 1 while $x; - $test = $test + 1; - print "ok $test\n"; - $[ = 0; # restore the original value for less side-effects -} - # [perl #2738] perl segfautls on input { eval q{ sub _ <> {} }; @@ -217,30 +207,6 @@ EOF like($@, qr/Illegal declaration of subroutine main::_/, "__FILE__ as prototype"); } -# [perl #36313] perl -e "1for$[=0" crash -{ - my $x; - $x = 1 for ($[) = 0; - $test = $test + 1; - print "ok $test - optimized assignment to \$[ used to segfault in list context\n"; - if ($[ = 0) { $x = 1 } - $test = $test + 1; - print "ok $test - optimized assignment to \$[ used to segfault in scalar context\n"; - $x = ($[=2.4); - is($x, 2, 'scalar assignment to $[ behaves like other variables'); - $x = (($[) = 0); - is($x, 1, 'list assignment to $[ behaves like other variables'); - $x = eval q{ ($[, $x) = (0) }; - like($@, qr/That use of \$\[ is unsupported/, - 'cannot assign to $[ in a list'); - eval q{ ($[) = (0, 1) }; - like($@, qr/That use of \$\[ is unsupported/, - 'cannot assign list of >1 elements to $['); - eval q{ ($[) = () }; - like($@, qr/That use of \$\[ is unsupported/, - 'cannot assign list of <1 elements to $['); -} - # tests for "Bad name" eval q{ foo::$bar }; like( $@, qr/Bad name after foo::/, 'Bad name after foo::' ); diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 0891bd8..73f1527 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -106,7 +106,6 @@ EXPECT Found = in conditional, should be == at - line 3. ######## # op.c -use warnings 'deprecated'; my (@foo, %foo); %main::foo->{"bar"}; %foo->{"bar"}; @@ -126,14 +125,14 @@ $foo = {}; %$foo->{"bar"}; $main::foo = []; @$main::foo->[34]; $foo = []; @$foo->[34]; EXPECT +Using a hash as a reference is deprecated at - line 3. Using a hash as a reference is deprecated at - line 4. -Using a hash as a reference is deprecated at - line 5. +Using an array as a reference is deprecated at - line 5. Using an array as a reference is deprecated at - line 6. -Using an array as a reference is deprecated at - line 7. +Using a hash as a reference is deprecated at - line 7. Using a hash as a reference is deprecated at - line 8. -Using a hash as a reference is deprecated at - line 9. +Using an array as a reference is deprecated at - line 9. Using an array as a reference is deprecated at - line 10. -Using an array as a reference is deprecated at - line 11. ######## # op.c use warnings 'void' ; close STDIN ; @@ -727,20 +726,18 @@ EXPECT Format FRED redefined at - line 5. ######## # op.c -use warnings 'deprecated' ; push FRED; no warnings 'deprecated' ; push FRED; EXPECT -Array @FRED missing the @ in argument 1 of push() at - line 3. +Array @FRED missing the @ in argument 1 of push() at - line 2. ######## # op.c -use warnings 'deprecated' ; @a = keys FRED ; no warnings 'deprecated' ; @a = keys FRED ; EXPECT -Hash %FRED missing the % in argument 1 of keys() at - line 3. +Hash %FRED missing the % in argument 1 of keys() at - line 2. ######## # op.c use warnings 'syntax' ; @@ -751,24 +748,21 @@ Statement unlikely to be reached at - line 4. (Maybe you meant system() when you said exec()?) ######## # op.c -use warnings 'deprecated' ; my @a; defined(@a); EXPECT -defined(@array) is deprecated at - line 3. +defined(@array) is deprecated at - line 2. (Maybe you should just omit the defined()?) ######## # op.c -use warnings 'deprecated' ; defined(@a = (1,2,3)); EXPECT -defined(@array) is deprecated at - line 3. +defined(@array) is deprecated at - line 2. (Maybe you should just omit the defined()?) ######## # op.c -use warnings 'deprecated' ; my %h; defined(%h); EXPECT -defined(%hash) is deprecated at - line 3. +defined(%hash) is deprecated at - line 2. (Maybe you should just omit the defined()?) ######## # op.c @@ -1031,7 +1025,6 @@ Useless localization of match position at - line 49. Useless localization of vec at - line 50. ######## # op.c -use warnings 'deprecated'; my $x1 if 0; my @x2 if 0; my %x3 if 0; @@ -1047,13 +1040,13 @@ if (my $w2) { $a=1 } if ($a && (my $w3 = 1)) {$a = 2} EXPECT +Deprecated use of my() in false conditional at - line 2. Deprecated use of my() in false conditional at - line 3. Deprecated use of my() in false conditional at - line 4. Deprecated use of my() in false conditional at - line 5. Deprecated use of my() in false conditional at - line 6. Deprecated use of my() in false conditional at - line 7. Deprecated use of my() in false conditional at - line 8. -Deprecated use of my() in false conditional at - line 9. ######## # op.c $[ = 1; @@ -1062,4 +1055,5 @@ $[ = 2; no warnings 'deprecated'; $[ = 3; EXPECT +Use of assignment to $[ is deprecated at - line 2. Use of assignment to $[ is deprecated at - line 4. diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index e5ca400..a7ef0f8 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -125,7 +125,6 @@ toke.c AOK __END__ # toke.c -use warnings 'deprecated' ; format STDOUT = @<<< @||| @>>> @>>> $a $b "abc" 'def' @@ -136,19 +135,18 @@ format STDOUT = $a $b "abc" 'def' . EXPECT -Use of comma-less variable list is deprecated at - line 5. -Use of comma-less variable list is deprecated at - line 5. -Use of comma-less variable list is deprecated at - line 5. +Use of comma-less variable list is deprecated at - line 4. +Use of comma-less variable list is deprecated at - line 4. +Use of comma-less variable list is deprecated at - line 4. ######## # toke.c -use warnings 'deprecated' ; $a = <<; no warnings 'deprecated' ; $a = <<; EXPECT -Use of bare << to mean <<"" is deprecated at - line 3. +Use of bare << to mean <<"" is deprecated at - line 2. ######## # toke.c use warnings 'syntax' ; @@ -853,7 +851,7 @@ sub glipp :locked { } sub whack_eth ($) : locked { } -use warnings 'deprecated'; +no warnings 'deprecated'; our $bar :unique; sub zapeth :locked; sub ker_plop :locked { @@ -861,10 +859,10 @@ sub ker_plop :locked { sub swa_a_p ($) : locked { } EXPECT -Use of :unique is deprecated at - line 9. -Use of :locked is deprecated at - line 10. -Use of :locked is deprecated at - line 11. -Use of :locked is deprecated at - line 13. +Use of :unique is deprecated at - line 2. +Use of :locked is deprecated at - line 3. +Use of :locked is deprecated at - line 4. +Use of :locked is deprecated at - line 6. ######## # toke.c use warnings "syntax"; diff --git a/t/op/array.t b/t/op/array.t index 74539a8..0027f4b 100644 --- a/t/op/array.t +++ b/t/op/array.t @@ -21,6 +21,9 @@ is($tmp, 5); is($#ary, 3); is(join('',@ary), '1234'); +{ + no warnings 'deprecated'; + $[ = 1; @ary = (1,2,3,4,5); is(join('',@ary), '12345'); @@ -70,6 +73,8 @@ $bar[2] = '2'; $r = join(',', $#bar, @bar); is($r, "2,0,,2"); +} + $foo = 'now is the time'; ok(scalar (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))); is($F1, 'now'); @@ -119,7 +124,10 @@ $foo = ('a','b','c','d','e','f')[1]; is($foo, 'b'); @foo = ( 'foo', 'bar', 'burbl'); -push(foo, 'blah'); +{ + no warnings 'deprecated'; + push(foo, 'blah'); +} is($#foo, 3); # various AASSIGN_COMMON checks (see newASSIGNOP() in op.c) @@ -252,6 +260,7 @@ is ($foo[1], "a"); sub tary { + no warnings 'deprecated'; local $[ = 10; my $five = 5; is ($tary[5], $tary[$five]); diff --git a/t/comp/hints.aux b/t/op/array_base.aux similarity index 100% copy from t/comp/hints.aux copy to t/op/array_base.aux diff --git a/t/op/array_base.t b/t/op/array_base.t new file mode 100644 index 0000000..3cc9b24 --- /dev/null +++ b/t/op/array_base.t @@ -0,0 +1,82 @@ +#!perl -w +use strict; + +require './test.pl'; + +plan (tests => 24); +no warnings 'deprecated'; + +# Bug #27024 +{ + # this used to segfault (because $[=1 is optimized away to a null block) + my $x; + $[ = 1 while $x; + pass('#27204'); + $[ = 0; # restore the original value for less side-effects +} + +# [perl #36313] perl -e "1for$[=0" crash +{ + my $x; + $x = 1 for ($[) = 0; + pass('optimized assignment to $[ used to segfault in list context'); + if ($[ = 0) { $x = 1 } + pass('optimized assignment to $[ used to segfault in scalar context'); + $x = ($[=2.4); + is($x, 2, 'scalar assignment to $[ behaves like other variables'); + $x = (($[) = 0); + is($x, 1, 'list assignment to $[ behaves like other variables'); + $x = eval q{ ($[, $x) = (0) }; + like($@, qr/That use of \$\[ is unsupported/, + 'cannot assign to $[ in a list'); + eval q{ ($[) = (0, 1) }; + like($@, qr/That use of \$\[ is unsupported/, + 'cannot assign list of >1 elements to $['); + eval q{ ($[) = () }; + like($@, qr/That use of \$\[ is unsupported/, + 'cannot assign list of <1 elements to $['); +} + + +{ + $[ = 11; + cmp_ok($[ + 0, '==', 11, 'setting $[ affects $['); + our $t11; BEGIN { $t11 = $^H{'$['} } + cmp_ok($t11, '==', 11, 'setting $[ affects $^H{\'$[\'}'); + + BEGIN { $^H{'$['} = 22 } + cmp_ok($[ + 0, '==', 22, 'setting $^H{\'$\'} affects $['); + our $t22; BEGIN { $t22 = $^H{'$['} } + cmp_ok($t22, '==', 22, 'setting $^H{\'$[\'} affects $^H{\'$[\'}'); + + BEGIN { %^H = () } + my $val = do { + no warnings 'uninitialized'; + $[; + }; + cmp_ok($val, '==', 0, 'clearing %^H affects $['); + our $t0; BEGIN { $t0 = $^H{'$['} } + cmp_ok($t0, '==', 0, 'clearing %^H affects $^H{\'$[\'}'); +} + +{ + $[ = 13; + BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; } + + our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; } + cmp_ok($[ + 0, '==', 13, '$[ correct before require'); + ok($ri0 & 0x04000000, '$^H correct before require'); + is($rf0, "z", '$^H{foo} correct before require'); + + our($ra1, $ri1, $rf1, $rfe1); + BEGIN { require "op/array_base.aux"; } + cmp_ok($ra1, '==', 0, '$[ cleared for require'); + ok(!($ri1 & 0x04000000), '$^H cleared for require'); + is($rf1, undef, '$^H{foo} cleared for require'); + ok(!$rfe1, '$^H{foo} cleared for require'); + + our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; } + cmp_ok($[ + 0, '==', 13, '$[ correct after require'); + ok($ri2 & 0x04000000, '$^H correct after require'); + is($rf2, "z", '$^H{foo} correct after require'); +} diff --git a/t/op/chop.t b/t/op/chop.t index 503f6f7..39577c2 100644 --- a/t/op/chop.t +++ b/t/op/chop.t @@ -9,7 +9,7 @@ BEGIN { plan tests => 139; $_ = 'abc'; -$c = do foo(); +$c = foo(); is ($c . $_, 'cab', 'optimized'); $_ = 'abc'; diff --git a/t/op/do.t b/t/op/do.t index 0fec534..e47441a 100644 --- a/t/op/do.t +++ b/t/op/do.t @@ -33,13 +33,19 @@ print "1..50\n"; # Test do &sub and proper @_ handling. $_[0] = 0; -$result = do foo1(1); +{ + no warnings 'deprecated'; + $result = do foo1(1); +} ok( $result eq 'value', ":$result: eq :value:" ); ok( $_[0] == 0 ); $_[0] = 0; -$result = do foo2(0,1,0); +{ + no warnings 'deprecated'; + $result = do foo2(0,1,0); +} ok( $result eq 'value', ":$result: eq :value:" ); ok( $_[0] == 0 ); @@ -50,10 +56,16 @@ sub blather { ok 1 foreach @_; } -do blather("ayep","sho nuff"); +{ + no warnings 'deprecated'; + do blather("ayep","sho nuff"); +} @x = ("jeepers", "okydoke"); @y = ("uhhuh", "yeppers"); -do blather(@x,"noofie",@y); +{ + no warnings 'deprecated'; + do blather(@x,"noofie",@y); +} unshift @INC, '.'; diff --git a/t/op/each.t b/t/op/each.t index 02438f2..765bfda 100644 --- a/t/op/each.t +++ b/t/op/each.t @@ -106,16 +106,22 @@ isnt ($size, (split('/', scalar %hash))[1]); is (keys(%hash), 10, "keys (%hash)"); -is (keys(hash), 10, "keys (hash)"); +{ + no warnings 'deprecated'; + is (keys(hash), 10, "keys (hash)"); +} $i = 0; %h = (a => A, b => B, c=> C, d => D, abc => ABC); -...@keys = keys(h); -...@values = values(h); -while (($key, $value) = each(h)) { +{ + no warnings 'deprecated'; + @keys = keys(h); + @values = values(h); + while (($key, $value) = each(h)) { if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { $i++; } + } } is ($i, 5); diff --git a/t/op/exists_sub.t b/t/op/exists_sub.t index d4aa292..012ea33 100644 --- a/t/op/exists_sub.t +++ b/t/op/exists_sub.t @@ -8,7 +8,7 @@ BEGIN { print "1..9\n"; sub t1; -sub t2 : locked; +sub t2 : lvalue; sub t3 (); sub t4 ($); sub t5 {1;} diff --git a/t/op/index.t b/t/op/index.t index 834814e..6cc3f42 100644 --- a/t/op/index.t +++ b/t/op/index.t @@ -137,7 +137,8 @@ foreach my $utf8 ('', ', utf-8') { foreach my $arraybase (0, 1, -1, -2) { my $expect_pos = 2 + $arraybase; - my $prog = "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; "; + my $prog = "no warnings 'deprecated';\n"; + $prog .= "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; "; $prog .= '$big .= chr 256; chop $big; ' if $utf8; $prog .= 'print rindex $big, "N", 2 + $['; diff --git a/t/op/lex.t b/t/op/lex.t new file mode 100644 index 0000000..3f00248 --- /dev/null +++ b/t/op/lex.t @@ -0,0 +1,22 @@ +#!perl -w +use strict; + +require './test.pl'; + +plan(tests => 2); + +{ + no warnings 'deprecated'; + print <<; # Yow! +ok 1 + + # previous line intentionally left blank. + + my $yow = "ok 2"; + print <<; # Yow! +$yow + + # previous line intentionally left blank. +} + +curr_test(3); diff --git a/t/op/local.t b/t/op/local.t index 211213b..db9912a 100644 --- a/t/op/local.t +++ b/t/op/local.t @@ -623,6 +623,7 @@ is($@, ""); # RT #4342 Special local() behavior for $[ { + no warnings 'deprecated'; local $[ = 1; ok(1 == $[, 'lexcical scope of local $['); f(); diff --git a/t/op/push.t b/t/op/push.t index 8b12e61..2024706 100644 --- a/t/op/push.t +++ b/t/op/push.t @@ -24,9 +24,15 @@ push(@x,4); if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} # test for push/pop intuiting @ on array -push(x,3); +{ + no warnings 'deprecated'; + push(x,3); +} if (join(':',@x) eq '1:2:3:1:2:3:4:3') {print "ok 3\n";} else {print "not ok 3\n";} -pop(x); +{ + no warnings 'deprecated'; + pop(x); +} if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 4\n";} else {print "not ok 4\n";} $test = 5; diff --git a/t/op/stat.t b/t/op/stat.t index 007869e..5167655 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -495,8 +495,11 @@ SKIP: { ok(-d DIR, "-d on a dirhandle works"); # And now for the ambigious bareword case - ok(open(DIR, "TEST"), 'Can open "TEST" dir') - || diag "Can't open 'TEST': $!"; + { + no warnings 'deprecated'; + ok(open(DIR, "TEST"), 'Can open "TEST" dir') + || diag "Can't open 'TEST': $!"; + } my $size = (stat(DIR))[7]; ok(defined $size, "stat() on bareword works"); is($size, -s "TEST", "size returned by stat of bareword is for the file"); @@ -525,8 +528,11 @@ SKIP: { ok(-d -r *DIR{IO} , "chained -x's on *DIR{IO}"); # And now for the ambigious bareword case - ok(open(DIR, "TEST"), 'Can open "TEST" dir') - || diag "Can't open 'TEST': $!"; + { + no warnings 'deprecated'; + ok(open(DIR, "TEST"), 'Can open "TEST" dir') + || diag "Can't open 'TEST': $!"; + } my $size = (stat(*DIR{IO}))[7]; ok(defined $size, "stat() on *THINGY{IO} works"); is($size, -s "TEST", diff --git a/t/op/undef.t b/t/op/undef.t index 8bfecab..7afaf9c 100644 --- a/t/op/undef.t +++ b/t/op/undef.t @@ -72,6 +72,7 @@ like $@, qr/^Modification of a read/; { require Tie::Hash; tie my %foo, 'Tie::StdHash'; + no warnings 'deprecated'; ok defined %foo; %foo = ( a => 1 ); ok defined %foo; @@ -80,6 +81,7 @@ like $@, qr/^Modification of a read/; { require Tie::Array; tie my @foo, 'Tie::StdArray'; + no warnings 'deprecated'; ok defined @foo; @foo = ( a => 1 ); ok defined @foo; diff --git a/t/op/unshift.t b/t/op/unshift.t index 0c26623..30291fb 100644 --- a/t/op/unshift.t +++ b/t/op/unshift.t @@ -3,10 +3,10 @@ print "1..2\n"; @a = (1,2,3); -$cnt1 = unshift(a,0); +$cnt1 = unshift(@a,0); if (join(' ',@a) eq '0 1 2 3') {print "ok 1\n";} else {print "not ok 1\n";} -$cnt2 = unshift(a,3,2,1); +$cnt2 = unshift(@a,3,2,1); if (join(' ',@a) eq '3 2 1 0 1 2 3') {print "ok 2\n";} else {print "not ok 2\n";} -- Perl5 Master Repository
