10 use vars qw{ @warnings };
13 $^W |= 1; # Insist upon warnings
14 # ...and save 'em as we go
15 $SIG{'__WARN__'} = sub { push @warnings, @_ };
20 END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
23 my($num, $bool, $diag) = @_;
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;
34 sub test_warning ($$$) {
35 my($num, $got, $expected) = @_;
37 if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
38 (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
40 $ok = ($got =~ /$pattern/);
41 test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
43 $ok = ($got eq $expected);
44 test $num, $ok, "Expected string '$expected', got '$got'\n";
46 # print "# $num: $got\n";
49 my $odd_msg = '/^Odd number of elements in 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_msg;
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;
70 test 7, ! @warnings, "Unexpected warning";