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 }