Commit | Line | Data |
1930e939 |
1 | #!./perl |
2 | |
1930e939 |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
1930e939 |
6 | } |
7 | |
90dc8f2b |
8 | use strict; |
9f1b1f2d |
9 | use warnings; |
90dc8f2b |
10 | |
1930e939 |
11 | use vars qw{ @warnings }; |
12 | |
13 | BEGIN { |
1930e939 |
14 | $SIG{'__WARN__'} = sub { push @warnings, @_ }; |
15 | $| = 1; |
10c8fecd |
16 | print "1..9\n"; |
1930e939 |
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 | |
b21befc1 |
48 | my $odd_msg = '/^Odd number of elements in hash assignment/'; |
49 | my $odd_msg2 = '/^Odd number of elements in anonymous hash/'; |
1930e939 |
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 }; |
b21befc1 |
60 | test_warning 3, shift @warnings, $odd_msg2; |
1930e939 |
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 | |
10c8fecd |
69 | my $avhv = [{x=>1,y=>2}]; |
70 | %$avhv = (x=>13,'y'); |
71 | test_warning 7, shift @warnings, $odd_msg; |
72 | |
73 | %$avhv = 'x'; |
74 | test_warning 8, shift @warnings, $odd_msg; |
75 | |
1930e939 |
76 | $_ = { 1..10 }; |
10c8fecd |
77 | test 9, ! @warnings, "Unexpected warning"; |
1930e939 |
78 | } |