From 89474f50ca76e8039d27bebe650de4addd0f1607 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 1 Nov 2011 18:25:59 -0700 Subject: [PATCH] =?utf8?q?Warn=20for=20$[=20=E2=80=98version=E2=80=99=20ch?= =?utf8?q?ecks?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Following Michael Schwern’s suggestion, here is a warning for those hapless folks who use $[ for version checks. It applies whenever $[ is used in one of: < > <= >= --- embed.h | 1 + op.c | 26 ++++++++++++++++++++++++++ opcode.h | 16 ++++++++-------- pod/perldiag.pod | 11 +++++++++++ proto.h | 6 ++++++ regen/opcodes | 16 ++++++++-------- t/lib/warnings/op | 40 ++++++++++++++++++++++++++++++++++++++++ 7 files changed, 100 insertions(+), 16 deletions(-) diff --git a/embed.h b/embed.h index 395c791..a47f513 100644 --- a/embed.h +++ b/embed.h @@ -988,6 +988,7 @@ #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_chdir(a) Perl_ck_chdir(aTHX_ a) +#define ck_cmp(a) Perl_ck_cmp(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) #define ck_defined(a) Perl_ck_defined(aTHX_ a) #define ck_delete(a) Perl_ck_delete(aTHX_ a) diff --git a/op.c b/op.c index c34dec5..96efde7 100644 --- a/op.c +++ b/op.c @@ -7284,6 +7284,32 @@ Perl_ck_bitop(pTHX_ OP *o) return o; } +PERL_STATIC_INLINE bool +is_dollar_bracket(pTHX_ const OP * const o) +{ + const OP *kid; + return o->op_type == OP_RV2SV && o->op_flags & OPf_KIDS + && (kid = cUNOPx(o)->op_first) + && kid->op_type == OP_GV + && strEQ(GvNAME(cGVOPx_gv(kid)), "["); +} + +OP * +Perl_ck_cmp(pTHX_ OP *o) +{ + PERL_ARGS_ASSERT_CK_CMP; + if (ckWARN(WARN_SYNTAX)) { + const OP *kid = cUNOPo->op_first; + if (kid && ( + is_dollar_bracket(aTHX_ kid) + || ((kid = kid->op_sibling) && is_dollar_bracket(aTHX_ kid)) + )) + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + "$[ used in %s (did you mean $] ?)", OP_DESC(o)); + } + return o; +} + OP * Perl_ck_concat(pTHX_ OP *o) { diff --git a/opcode.h b/opcode.h index 0d0990e..34f8b48 100644 --- a/opcode.h +++ b/opcode.h @@ -1381,14 +1381,14 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_fun, /* stringify */ Perl_ck_bitop, /* left_shift */ Perl_ck_bitop, /* right_shift */ - Perl_ck_null, /* lt */ - Perl_ck_null, /* i_lt */ - Perl_ck_null, /* gt */ - Perl_ck_null, /* i_gt */ - Perl_ck_null, /* le */ - Perl_ck_null, /* i_le */ - Perl_ck_null, /* ge */ - Perl_ck_null, /* i_ge */ + Perl_ck_cmp, /* lt */ + Perl_ck_cmp, /* i_lt */ + Perl_ck_cmp, /* gt */ + Perl_ck_cmp, /* i_gt */ + Perl_ck_cmp, /* le */ + Perl_ck_cmp, /* i_le */ + Perl_ck_cmp, /* ge */ + Perl_ck_cmp, /* i_ge */ Perl_ck_null, /* eq */ Perl_ck_null, /* i_eq */ Perl_ck_null, /* ne */ diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 6f2416a..a477db8 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -5017,6 +5017,17 @@ See L for more information. (F) You called a Win32 function with incorrect arguments. See L for more information. +=item $[ used in %s (did you mean $] ?) + +(W syntax) You used C<$[> in a comparison, such as: + + if ($[ > 5.006) { + ... + } + +You probably meant to use C<$]> instead. C<$[> is the base for indexing +arrays. C<$]> is the Perl version number in decimal. + =item Useless assignment to a temporary (W misc) You assigned to an lvalue subroutine, but what diff --git a/proto.h b/proto.h index a70802b..c52b4d1 100644 --- a/proto.h +++ b/proto.h @@ -290,6 +290,12 @@ PERL_CALLCONV OP * Perl_ck_chdir(pTHX_ OP *o) #define PERL_ARGS_ASSERT_CK_CHDIR \ assert(o) +PERL_CALLCONV OP * Perl_ck_cmp(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_CK_CMP \ + assert(o) + PERL_CALLCONV OP * Perl_ck_concat(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); diff --git a/regen/opcodes b/regen/opcodes index 688f166..5b988a1 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -138,14 +138,14 @@ stringify string ck_fun fsT@ S left_shift left bitshift (<<) ck_bitop fsT2 S S right_shift right bitshift (>>) ck_bitop fsT2 S S -lt numeric lt (<) ck_null Iifs2 S S< -i_lt integer lt (<) ck_null ifs2 S S< -gt numeric gt (>) ck_null Iifs2 S S< -i_gt integer gt (>) ck_null ifs2 S S< -le numeric le (<=) ck_null Iifs2 S S< -i_le integer le (<=) ck_null ifs2 S S< -ge numeric ge (>=) ck_null Iifs2 S S< -i_ge integer ge (>=) ck_null ifs2 S S< +lt numeric lt (<) ck_cmp Iifs2 S S< +i_lt integer lt (<) ck_cmp ifs2 S S< +gt numeric gt (>) ck_cmp Iifs2 S S< +i_gt integer gt (>) ck_cmp ifs2 S S< +le numeric le (<=) ck_cmp Iifs2 S S< +i_le integer le (<=) ck_cmp ifs2 S S< +ge numeric ge (>=) ck_cmp Iifs2 S S< +i_ge integer ge (>=) ck_cmp ifs2 S S< eq numeric eq (==) ck_null Iifs2 S S< i_eq integer eq (==) ck_null ifs2 S S< ne numeric ne (!=) ck_null Iifs2 S S< diff --git a/t/lib/warnings/op b/t/lib/warnings/op index f6f105d..7f00838 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -72,6 +72,8 @@ defined(%hash) is deprecated (Maybe you should just omit the defined()?) my %h ; defined %h ; + + $[ used in comparison (did you mean $] ?) /---/ should probably be written as "---" join(/---/, @foo); @@ -880,6 +882,44 @@ Prototype mismatch: sub main::fred () vs ($) at - line 4. Prototype mismatch: sub main::freD () vs ($) at - line 11. Prototype mismatch: sub main::FRED () vs ($) at - line 14. ######## +# op.c [Perl_ck_cmp] +use warnings 'syntax' ; +no warnings 'deprecated'; +@a = $[ < 5; +@a = $[ > 5; +@a = $[ <= 5; +@a = $[ >= 5; +@a = 42 < $[; +@a = 42 > $[; +@a = 42 <= $[; +@a = 42 >= $[; +use integer; +@a = $[ < 5; +@a = $[ > 5; +@a = $[ <= 5; +@a = $[ >= 5; +@a = 42 < $[; +@a = 42 > $[; +@a = 42 <= $[; +@a = 42 >= $[; +EXPECT +$[ used in numeric lt (<) (did you mean $] ?) at - line 4. +$[ used in numeric gt (>) (did you mean $] ?) at - line 5. +$[ used in numeric le (<=) (did you mean $] ?) at - line 6. +$[ used in numeric ge (>=) (did you mean $] ?) at - line 7. +$[ used in numeric lt (<) (did you mean $] ?) at - line 8. +$[ used in numeric gt (>) (did you mean $] ?) at - line 9. +$[ used in numeric le (<=) (did you mean $] ?) at - line 10. +$[ used in numeric ge (>=) (did you mean $] ?) at - line 11. +$[ used in numeric lt (<) (did you mean $] ?) at - line 13. +$[ used in numeric gt (>) (did you mean $] ?) at - line 14. +$[ used in numeric le (<=) (did you mean $] ?) at - line 15. +$[ used in numeric ge (>=) (did you mean $] ?) at - line 16. +$[ used in numeric lt (<) (did you mean $] ?) at - line 17. +$[ used in numeric gt (>) (did you mean $] ?) at - line 18. +$[ used in numeric le (<=) (did you mean $] ?) at - line 19. +$[ used in numeric ge (>=) (did you mean $] ?) at - line 20. +######## # op.c use warnings 'syntax' ; join /---/, 'x', 'y', 'z'; -- 1.8.3.1