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/';
  49 my $ref_msg = '/^Reference found where even-sized list expected/';
  50
  51 {
  52     my %hash = (1..3);
  53     test_warning 1, shift @warnings, $odd_msg;
  54
  55     %hash = 1;
  56     test_warning 2, shift @warnings, $odd_msg;
  57
  58     %hash = { 1..3 };
  59     test_warning 3, shift @warnings, $odd_msg;
  60     test_warning 4, shift @warnings, $ref_msg;
  61
  62     %hash = [ 1..3 ];
  63     test_warning 5, shift @warnings, $ref_msg;
  64
  65     %hash = sub { print "ok" };
  66     test_warning 6, shift @warnings, $odd_msg;
  67
  68     my $avhv = [{x=>1,y=>2}];
  69     %$avhv = (x=>13,'y');
  70     test_warning 7, shift @warnings, $odd_msg;
  71
  72     %$avhv = 'x';
  73     test_warning 8, shift @warnings, $odd_msg;
  74
  75     $_ = { 1..10 };
  76     test 9, ! @warnings, "Unexpected warning";
  77 }