t/op/hashwarn.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use strict;
   9 use warnings;
  10
  11 use vars qw{ @warnings };
  12
  13 BEGIN {
  14     $SIG{'__WARN__'} = sub { push @warnings, @_ };
  15     $| = 1;
  16     print "1..9\n";
  17 }
  18
  19 END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
  20
  21 sub test ($$;$) {
  22     my($num, $bool, $diag) = @_;
  23     if ($bool) {
  24         print "ok $num\n";
  25         return;
  26     }
  27     print "not ok $num\n";
  28     return unless defined $diag;
  29     $diag =~ s/\Z\n?/\n/;                       # unchomp
  30     print map "# $num : $_", split m/^/m, $diag;
  31 }
  32
  33 sub test_warning ($$$) {
  34     my($num, $got, $expected) = @_;
  35     my($pattern, $ok);
  36     if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
  37         (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
  38             # it's a regexp
  39             $ok = ($got =~ /$pattern/);
  40             test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
  41     } else {
  42         $ok = ($got eq $expected);
  43         test $num, $ok, "Expected string '$expected', got '$got'\n";
  44     }
  45 #   print "# $num: $got\n";
  46 }
  47
  48 my $odd_msg = '/^Odd number of elements in hash assignment/';
  49 my $odd_msg2 = '/^Odd number of elements in anonymous hash/';
  50 my $ref_msg = '/^Reference found where even-sized list expected/';
  51
  52 {
  53     my %hash = (1..3);
  54     test_warning 1, shift @warnings, $odd_msg;
  55
  56     %hash = 1;
  57     test_warning 2, shift @warnings, $odd_msg;
  58
  59     %hash = { 1..3 };
  60     test_warning 3, shift @warnings, $odd_msg2;
  61     test_warning 4, shift @warnings, $ref_msg;
  62
  63     %hash = [ 1..3 ];
  64     test_warning 5, shift @warnings, $ref_msg;
  65
  66     %hash = sub { print "ok" };
  67     test_warning 6, shift @warnings, $odd_msg;
  68
  69     # Old pseudo-hash syntax, now removed.
  70     my $avhv = [{x=>1,y=>2}];
  71     eval {
  72         %$avhv = (x=>13,'y');
  73     };
  74     test 7, $@ =~ /^Not a HASH reference/;
  75
  76     # Old pseudo-hash syntax, since removed.
  77     eval {
  78         %$avhv = 'x';
  79     };
  80     test 8, $@ =~ /^Not a HASH reference/;
  81
  82     $_ = { 1..10 };
  83     test 9, ! @warnings, "Unexpected warning";
  84 }