11 use vars qw{ @warnings };
14 $SIG{'__WARN__'} = sub { push @warnings, @_ };
19 END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
22 my($num, $bool, $diag) = @_;
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;
33 sub test_warning ($$$) {
34 my($num, $got, $expected) = @_;
36 if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
37 (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
39 $ok = ($got =~ /$pattern/);
40 test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
42 $ok = ($got eq $expected);
43 test $num, $ok, "Expected string '$expected', got '$got'\n";
45 # print "# $num: $got\n";
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/';
54 test_warning 1, shift @warnings, $odd_msg;
57 test_warning 2, shift @warnings, $odd_msg;
60 test_warning 3, shift @warnings, $odd_msg2;
61 test_warning 4, shift @warnings, $ref_msg;
64 test_warning 5, shift @warnings, $ref_msg;
66 %hash = sub { print "ok" };
67 test_warning 6, shift @warnings, $odd_msg;
69 my $avhv = [{x=>1,y=>2}];
71 test_warning 7, shift @warnings, $odd_msg;
74 test_warning 8, shift @warnings, $odd_msg;
77 test 9, ! @warnings, "Unexpected warning";