1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateuse strict; 9*0Sstevel@tonic-gateuse warnings; 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gateuse vars qw{ @warnings }; 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gateBEGIN { 14*0Sstevel@tonic-gate $SIG{'__WARN__'} = sub { push @warnings, @_ }; 15*0Sstevel@tonic-gate $| = 1; 16*0Sstevel@tonic-gate print "1..9\n"; 17*0Sstevel@tonic-gate} 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateEND { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings } 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gatesub test ($$;$) { 22*0Sstevel@tonic-gate my($num, $bool, $diag) = @_; 23*0Sstevel@tonic-gate if ($bool) { 24*0Sstevel@tonic-gate print "ok $num\n"; 25*0Sstevel@tonic-gate return; 26*0Sstevel@tonic-gate } 27*0Sstevel@tonic-gate print "not ok $num\n"; 28*0Sstevel@tonic-gate return unless defined $diag; 29*0Sstevel@tonic-gate $diag =~ s/\Z\n?/\n/; # unchomp 30*0Sstevel@tonic-gate print map "# $num : $_", split m/^/m, $diag; 31*0Sstevel@tonic-gate} 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gatesub test_warning ($$$) { 34*0Sstevel@tonic-gate my($num, $got, $expected) = @_; 35*0Sstevel@tonic-gate my($pattern, $ok); 36*0Sstevel@tonic-gate if (($pattern) = ($expected =~ m#^/(.+)/$#s) or 37*0Sstevel@tonic-gate (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) { 38*0Sstevel@tonic-gate # it's a regexp 39*0Sstevel@tonic-gate $ok = ($got =~ /$pattern/); 40*0Sstevel@tonic-gate test $num, $ok, "Expected pattern /$pattern/, got '$got'\n"; 41*0Sstevel@tonic-gate } else { 42*0Sstevel@tonic-gate $ok = ($got eq $expected); 43*0Sstevel@tonic-gate test $num, $ok, "Expected string '$expected', got '$got'\n"; 44*0Sstevel@tonic-gate } 45*0Sstevel@tonic-gate# print "# $num: $got\n"; 46*0Sstevel@tonic-gate} 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gatemy $odd_msg = '/^Odd number of elements in hash assignment/'; 49*0Sstevel@tonic-gatemy $odd_msg2 = '/^Odd number of elements in anonymous hash/'; 50*0Sstevel@tonic-gatemy $ref_msg = '/^Reference found where even-sized list expected/'; 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate{ 53*0Sstevel@tonic-gate my %hash = (1..3); 54*0Sstevel@tonic-gate test_warning 1, shift @warnings, $odd_msg; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate %hash = 1; 57*0Sstevel@tonic-gate test_warning 2, shift @warnings, $odd_msg; 58*0Sstevel@tonic-gate 59*0Sstevel@tonic-gate %hash = { 1..3 }; 60*0Sstevel@tonic-gate test_warning 3, shift @warnings, $odd_msg2; 61*0Sstevel@tonic-gate test_warning 4, shift @warnings, $ref_msg; 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gate %hash = [ 1..3 ]; 64*0Sstevel@tonic-gate test_warning 5, shift @warnings, $ref_msg; 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gate %hash = sub { print "ok" }; 67*0Sstevel@tonic-gate test_warning 6, shift @warnings, $odd_msg; 68*0Sstevel@tonic-gate 69*0Sstevel@tonic-gate { 70*0Sstevel@tonic-gate # "Pseudo-hashes are deprecated" warnings tested in warnings/av 71*0Sstevel@tonic-gate no warnings 'deprecated'; 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate my $avhv = [{x=>1,y=>2}]; 74*0Sstevel@tonic-gate %$avhv = (x=>13,'y'); 75*0Sstevel@tonic-gate test_warning 7, shift @warnings, $odd_msg; 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gate %$avhv = 'x'; 78*0Sstevel@tonic-gate test_warning 8, shift @warnings, $odd_msg; 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gate $_ = { 1..10 }; 81*0Sstevel@tonic-gate test 9, ! @warnings, "Unexpected warning"; 82*0Sstevel@tonic-gate } 83*0Sstevel@tonic-gate} 84