xref: /openbsd-src/gnu/usr.bin/perl/t/op/hashwarn.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc( qw(. ../lib) );
7}
8
9plan( tests => 20 );
10
11use strict;
12use warnings;
13
14our @warnings;
15
16BEGIN {
17    $SIG{'__WARN__'} = sub { push @warnings, @_ };
18    $| = 1;
19}
20
21my $fail_odd      = 'Odd number of elements in hash assignment at ';
22my $fail_odd_anon = 'Odd number of elements in anonymous hash at ';
23my $fail_ref      = 'Reference found where even-sized list expected at ';
24my $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    # GH #21478
54    @warnings = ();
55    my $hashref = { 1 };
56    is(scalar(@warnings), 1, 'anon singleton count');
57    is(substr($warnings[0], 0, length($fail_odd_anon)), $fail_odd_anon, 'anon singleton msg');
58
59    @warnings = ();
60    $_ = { 1..10 };
61    cmp_ok(scalar(@warnings),'==',0,'hashref assign');
62
63    # Old pseudo-hash syntax, now removed.
64
65    @warnings = ();
66    my $avhv = [{x=>1,y=>2}];
67    eval {
68        %$avhv = (x=>13,'y');
69    };
70    cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 1 count');
71    cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 1 msg');
72
73    @warnings = ();
74    eval {
75        %$avhv = 'x';
76    };
77    cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 2 count');
78    cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 2 msg');
79}
80
81# RT #128189
82# this used to coredump
83
84{
85    @warnings = ();
86    my %h;
87
88    no warnings;
89    use warnings qw(uninitialized);
90
91    my $x = "$h{\1}";
92    is(scalar @warnings, 1, "RT #128189 - 1 warning");
93    like("@warnings",
94        qr/Use of uninitialized value \$h\{"SCALAR\(0x[\da-f]+\)"\}/,
95        "RT #128189 correct warning");
96}
97