1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8use strict; 9use warnings; 10 11use vars qw{ @warnings }; 12 13BEGIN { 14 $SIG{'__WARN__'} = sub { push @warnings, @_ }; 15 $| = 1; 16 print "1..9\n"; 17} 18 19END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings } 20 21sub 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 33sub 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 48my $odd_msg = '/^Odd number of elements in hash assignment/'; 49my $odd_msg2 = '/^Odd number of elements in anonymous hash/'; 50my $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 { 70 # "Pseudo-hashes are deprecated" warnings tested in warnings/av 71 no warnings 'deprecated'; 72 73 my $avhv = [{x=>1,y=>2}]; 74 %$avhv = (x=>13,'y'); 75 test_warning 7, shift @warnings, $odd_msg; 76 77 %$avhv = 'x'; 78 test_warning 8, shift @warnings, $odd_msg; 79 80 $_ = { 1..10 }; 81 test 9, ! @warnings, "Unexpected warning"; 82 } 83} 84