This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
50c993939fae56952c542ad449bb35bad85516f0
[perl5.git] / t / op / hashwarn.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 use strict;
9 use warnings;
10
11 use vars qw{ @warnings };
12
13 BEGIN {
14     $SIG{'__WARN__'} = sub { push @warnings, @_ };
15     $| = 1;
16     print "1..9\n";
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
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/';
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     # Old pseudo-hash syntax, now removed.
70     my $avhv = [{x=>1,y=>2}];
71     eval {
72         %$avhv = (x=>13,'y');
73     };
74     test 7, $@ =~ /^Not a HASH reference/;
75
76     # Old pseudo-hash syntax, since removed.
77     eval {
78         %$avhv = 'x';
79     };
80     test 8, $@ =~ /^Not a HASH reference/;
81
82     $_ = { 1..10 };
83     test 9, ! @warnings, "Unexpected warning";
84 }