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

7 files changed, 100 insertions, 16 deletions

diff --git a/embed.h b/embed.h
index 395c7912f8..a47f513d05 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 c34dec5f1c..96efde7686 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 0d0990e4e1..34f8b48752 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 6f2416a0a8..a477db85d2 100644
--- 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 a70802bb17..c52b4d1085 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 688f1661cd..5b988a11aa 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 f6f105d222..7f008382f7 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';