t/op/hashwarn.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     unshift @INC, '../lib';
   6 }
   7
   8 use strict;
   9
  10 use vars qw{ @warnings };
  11
  12 BEGIN {
  13     $^W |= 1;           # Insist upon warnings
  14     # ...and save 'em as we go
  15     $SIG{'__WARN__'} = sub { push @warnings, @_ };
  16     $| = 1;
  17     print "1..7\n";
  18 }
  19
  20 END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
  21
  22 sub test ($$;$) {
  23     my($num, $bool, $diag) = @_;
  24     if ($bool) {
  25         print "ok $num\n";
  26         return;
  27     }
  28     print "not ok $num\n";
  29     return unless defined $diag;
  30     $diag =~ s/\Z\n?/\n/;                       # unchomp
  31     print map "# $num : $_", split m/^/m, $diag;
  32 }
  33
  34 sub test_warning ($$$) {
  35     my($num, $got, $expected) = @_;
  36     my($pattern, $ok);
  37     if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
  38         (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
  39             # it's a regexp
  40             $ok = ($got =~ /$pattern/);
  41             test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
  42     } else {
  43         $ok = ($got eq $expected);
  44         test $num, $ok, "Expected string '$expected', got '$got'\n";
  45     }
  46 #   print "# $num: $got\n";
  47 }
  48
  49 my $odd_msg = '/^Odd number of elements in 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_msg;
  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     $_ = { 1..10 };
  70     test 7, ! @warnings, "Unexpected warning";
  71 }