Re: Odd number of elements in hash list.

p4raw-id: //depot/perl@858

diff --git a/MANIFEST b/MANIFEST
index 92f4001..150f439 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -826,6 +826,7 @@ t/op/glob.t         See if <*> works
 t/op/goto.t            See if goto works
 t/op/groups.t          See if $( works
 t/op/gv.t              See if typeglobs work
+t/op/hashwarn.t                See if warnings for bad hash assignments work
 t/op/inc.t             See if inc/dec of integers near 32 bit limit work
 t/op/index.t           See if index works
 t/op/int.t             See if int works

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 77b714c..96f5c67 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1711,10 +1711,10 @@ about 250 characters.  You've exceeded that length.  Future versions of
 Perl are likely to eliminate this arbitrary limitation.  In the meantime,
 try using scientific notation (e.g. "1e6" instead of "1_000_000").
 
-=item Odd number of elements in hash list
+=item Odd number of elements in hash assignment
 
-(S) You specified an odd number of elements to a hash list, which is odd,
-because hash lists come in key/value pairs.
+(S) You specified an odd number of elements to initialize a hash, which
+is odd, because hashes come in key/value pairs.
 
 =item Offset outside string
 
@@ -2063,6 +2063,18 @@ which is why it's currently left out of your copy.
 (F) More than 100 levels of inheritance were used.  Probably indicates
 an unintended loop in your inheritance hierarchy.
 
+=item Reference found where even-sized list expected
+
+(W) You gave a single reference where Perl was expecting a list with
+an even number of elements (for assignment to a hash). This
+usually means that you used the anon hash constructor when you meant 
+to use parens. In any case, a hash requires key/value B<pairs>.
+
+    %hash = { one => 1, two => 2, };   # WRONG
+    %hash = [ qw/ an anon array / ];   # WRONG
+    %hash = ( one => 1, two => 2, );   # right
+    %hash = qw( one 1 two 2 );                 # also fine
+
 =item Reference miscount in sv_replace()
 
 (W) The internal sv_replace() function was handed a new SV with a

diff --git a/pp.c b/pp.c
index f2a6141..3dc5a72 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2489,7 +2489,7 @@ PP(pp_anonhash)
        if (MARK < SP)
            sv_setsv(val, *++MARK);
        else if (dowarn)
-           warn("Odd number of elements in hash list");
+           warn("Odd number of elements in hash assignment");
        (void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;

diff --git a/pp_hot.c b/pp_hot.c
index 1d8ef68..0422605 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -644,8 +644,15 @@ PP(pp_aassign)
                    }
                    TAINT_NOT;
                }
-               if (relem == lastrelem && dowarn)
-                   warn("Odd number of elements in hash list");
+               if (relem == lastrelem && dowarn) {
+                   if (relem == firstrelem &&
+                       SvROK(*relem) &&
+                       ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+                         SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+                       warn("Reference found where even-sized list expected");
+                   else
+                       warn("Odd number of elements in hash assignment");
+               }
            }
            break;
        default:

diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t
new file mode 100755 (executable)
index 0000000..7419826
--- /dev/null
+++ b/t/op/hashwarn.t
@@ -0,0 +1,70 @@
+#!./perl
+
+use strict;
+
+BEGIN {
+    chdir 't' if -d 't';
+}
+
+use vars qw{ @warnings };
+
+BEGIN {
+    $^W |= 1;          # Insist upon warnings
+    # ...and save 'em as we go
+    $SIG{'__WARN__'} = sub { push @warnings, @_ };
+    $| = 1;
+    print "1..7\n";
+}
+
+END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
+
+sub test ($$;$) {
+    my($num, $bool, $diag) = @_;
+    if ($bool) {
+       print "ok $num\n";
+       return;
+    }
+    print "not ok $num\n";
+    return unless defined $diag;
+    $diag =~ s/\Z\n?/\n/;                      # unchomp
+    print map "# $num : $_", split m/^/m, $diag;
+}
+
+sub test_warning ($$$) {
+    my($num, $got, $expected) = @_;
+    my($pattern, $ok);
+    if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
+       (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
+           # it's a regexp
+           $ok = ($got =~ /$pattern/);
+           test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
+    } else {
+       $ok = ($got eq $expected);
+       test $num, $ok, "Expected string '$expected', got '$got'\n";
+    }
+#   print "# $num: $got\n";
+}
+
+my $odd_msg = '/^Odd number of elements in hash/';
+my $ref_msg = '/^Reference found where even-sized list expected/';
+
+{
+    my %hash = (1..3);
+    test_warning 1, shift @warnings, $odd_msg;
+
+    %hash = 1;
+    test_warning 2, shift @warnings, $odd_msg;
+
+    %hash = { 1..3 };
+    test_warning 3, shift @warnings, $odd_msg;
+    test_warning 4, shift @warnings, $ref_msg;
+
+    %hash = [ 1..3 ];
+    test_warning 5, shift @warnings, $ref_msg;
+
+    %hash = sub { print "ok" };
+    test_warning 6, shift @warnings, $odd_msg;
+
+    $_ = { 1..10 };
+    test 7, ! @warnings, "Unexpected warning";
+}