Throw a helpful warning when someone tries length(@array) or length(%hash)

diff --git a/embed.h b/embed.h
index 8ed8d32..5771ad7 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1005,6 +1005,7 @@
 #define ck_grep(a)             Perl_ck_grep(aTHX_ a)
 #define ck_index(a)            Perl_ck_index(aTHX_ a)
 #define ck_join(a)             Perl_ck_join(aTHX_ a)
+#define ck_length(a)           Perl_ck_length(aTHX_ a)
 #define ck_lfun(a)             Perl_ck_lfun(aTHX_ a)
 #define ck_listiob(a)          Perl_ck_listiob(aTHX_ a)
 #define ck_match(a)            Perl_ck_match(aTHX_ a)

diff --git a/op.c b/op.c
index 63e5a4a..6d0736d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9664,6 +9664,39 @@ Perl_ck_each(pTHX_ OP *o)
     return o->op_type == ref_type ? o : ck_fun(o);
 }
 
+OP *
+Perl_ck_length(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_CK_LENGTH;
+
+    o = ck_fun(o);
+
+    if (ckWARN(WARN_SYNTAX)) {
+        const OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : NULL;
+
+        if (kid) {
+            switch (kid->op_type) {
+                case OP_PADHV:
+                case OP_RV2HV:
+                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                        "length() used on %%hash (did you mean \"scalar(keys %%hash)\"?)");
+                    break;
+
+                case OP_PADAV:
+                case OP_RV2AV:
+                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                        "length() used on @array (did you mean \"scalar(@array)\"?)");
+                    break;
+
+                default:
+                    break;
+            }
+        }
+    }
+
+    return o;
+}
+
 /* caller is supposed to assign the return to the 
    container of the rep_op var */
 STATIC OP *

diff --git a/opcode.h b/opcode.h
index 99b2524..a1b9d2e 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1422,7 +1422,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_fun,            /* hex */
        Perl_ck_fun,            /* oct */
        Perl_ck_fun,            /* abs */
-       Perl_ck_fun,            /* length */
+       Perl_ck_length,         /* length */
        Perl_ck_substr,         /* substr */
        Perl_ck_fun,            /* vec */
        Perl_ck_index,          /* index */

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 594d58a..50a5c00 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2463,6 +2463,19 @@ effective uids or gids failed.
 length/code combination tried to obtain more data. This results in
 an undefined value for the length. See L<perlfunc/pack>.
 
+=item length() used on %s
+
+(W syntax) You used length() on either an array or a hash when you probably 
+wanted a count of the items.
+
+Array size can be obtained by doing:
+
+    scalar(@array);
+
+The number of items in a hash can be obtained by doing:
+
+    scalar(keys %hash);
+
 =item Lexing code attempted to stuff non-Latin-1 character into Latin-1 input
 
 (F) An extension is attempting to insert text into the current parse

diff --git a/proto.h b/proto.h
index 61bab08..bf18d53 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -418,6 +418,12 @@ PERL_CALLCONV OP * Perl_ck_join(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_CK_JOIN       \
        assert(o)
 
+PERL_CALLCONV OP *     Perl_ck_length(pTHX_ OP *o)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CK_LENGTH     \
+       assert(o)
+
 PERL_CALLCONV OP *     Perl_ck_lfun(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/regen/opcodes b/regen/opcodes
index 45cf693..f75411e 100644 (file)
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -192,7 +192,7 @@ abs         abs                     ck_fun          fsTu%   S?
 
 # String stuff.
 
-length         length                  ck_fun          ifsTu%  S?
+length         length                  ck_length       ifsTu%  S?
 substr         substr                  ck_substr       st@     S S S? S?
 vec            vec                     ck_fun          ist@    S S S
 

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 3797b38..b66e775 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -74,7 +74,10 @@
        my %h ; defined %h ;
 
      $[ used in comparison (did you mean $] ?)
-    
+
+     length() used on @array (did you mean "scalar(@array)"?)
+     length() used on %hash (did you mean "scalar(keys %hash)"?)
+
      /---/ should probably be written as "---"
         join(/---/, @foo);
 
@@ -920,6 +923,19 @@ $[ 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 [Perl_ck_length]
+use warnings 'syntax' ;
+length(@a);
+length(%a);
+length(@$a);
+length(%$a);
+length($a);
+EXPECT
+length() used on @array (did you mean "scalar(@array)"?) at - line 3.
+length() used on %hash (did you mean "scalar(keys %hash)"?) at - line 4.
+length() used on @array (did you mean "scalar(@array)"?) at - line 5.
+length() used on %hash (did you mean "scalar(keys %hash)"?) at - line 6.
+########
 # op.c
 use warnings 'syntax' ;
 join /---/, 'x', 'y', 'z';