Warn for $[ ‘version’ checks

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: < > <= >=

diff --git a/embed.h b/embed.h
index 395c791..a47f513 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -5017,6 +5017,17 @@ See L<POSIX/FUNCTIONS> for more information.
 (F) You called a Win32 function with incorrect arguments.
 See L<Win32> 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 (file)
--- 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 (file)
--- 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 (file)
--- 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';