they seek him here, they seek him there
[perl.git] / t / op / hashwarn.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc( qw(. ../lib) );
7 }
8
9 plan( tests => 18 );
10
11 use strict;
12 use warnings;
13
14 our @warnings;
15
16 BEGIN {
17     $SIG{'__WARN__'} = sub { push @warnings, @_ };
18     $| = 1;
19 }
20
21 my $fail_odd      = 'Odd number of elements in hash assignment at ';
22 my $fail_odd_anon = 'Odd number of elements in anonymous hash at ';
23 my $fail_ref      = 'Reference found where even-sized list expected at ';
24 my $fail_not_hr   = 'Not a HASH reference at ';
25
26 {
27     @warnings = ();
28     my %hash = (1..3);
29     cmp_ok(scalar(@warnings),'==',1,'odd count');
30     cmp_ok(substr($warnings[0],0,length($fail_odd)),'eq',$fail_odd,'odd msg');
31
32     @warnings = ();
33     %hash = 1;
34     cmp_ok(scalar(@warnings),'==',1,'scalar count');
35     cmp_ok(substr($warnings[0],0,length($fail_odd)),'eq',$fail_odd,'scalar msg');
36
37     @warnings = ();
38     %hash = { 1..3 };
39     cmp_ok(scalar(@warnings),'==',2,'odd hashref count');
40     cmp_ok(substr($warnings[0],0,length($fail_odd_anon)),'eq',$fail_odd_anon,'odd hashref msg 1');
41     cmp_ok(substr($warnings[1],0,length($fail_ref)),'eq',$fail_ref,'odd hashref msg 2');
42
43     @warnings = ();
44     %hash = [ 1..3 ];
45     cmp_ok(scalar(@warnings),'==',1,'arrayref count');
46     cmp_ok(substr($warnings[0],0,length($fail_ref)),'eq',$fail_ref,'arrayref msg');
47
48     @warnings = ();
49     %hash = sub { print "fenice" };
50     cmp_ok(scalar(@warnings),'==',1,'coderef count');
51     cmp_ok(substr($warnings[0],0,length($fail_odd)),'eq',$fail_odd,'coderef msg');
52
53     @warnings = ();
54     $_ = { 1..10 };
55     cmp_ok(scalar(@warnings),'==',0,'hashref assign');
56
57     # Old pseudo-hash syntax, now removed.
58
59     @warnings = ();
60     my $avhv = [{x=>1,y=>2}];
61     eval {
62         %$avhv = (x=>13,'y');
63     };
64     cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 1 count');
65     cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 1 msg');
66
67     @warnings = ();
68     eval {
69         %$avhv = 'x';
70     };
71     cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 2 count');
72     cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 2 msg');
73 }
74
75 # RT #128189
76 # this used to coredump
77
78 {
79     @warnings = ();
80     my %h;
81
82     no warnings;
83     use warnings qw(uninitialized);
84
85     my $x = "$h{\1}";
86     is(scalar @warnings, 1, "RT #128189 - 1 warning");
87     like("@warnings",
88         qr/Use of uninitialized value \$h\{"SCALAR\(0x[\da-f]+\)"\}/,
89         "RT #128189 correct warning");
90 }