1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/Ause strict;
1N/Ause warnings;
1N/A
1N/Ause vars qw{ @warnings };
1N/A
1N/ABEGIN {
1N/A $SIG{'__WARN__'} = sub { push @warnings, @_ };
1N/A $| = 1;
1N/A print "1..9\n";
1N/A}
1N/A
1N/AEND { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
1N/A
1N/Asub test ($$;$) {
1N/A my($num, $bool, $diag) = @_;
1N/A if ($bool) {
1N/A print "ok $num\n";
1N/A return;
1N/A }
1N/A print "not ok $num\n";
1N/A return unless defined $diag;
1N/A $diag =~ s/\Z\n?/\n/; # unchomp
1N/A print map "# $num : $_", split m/^/m, $diag;
1N/A}
1N/A
1N/Asub test_warning ($$$) {
1N/A my($num, $got, $expected) = @_;
1N/A my($pattern, $ok);
1N/A if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
1N/A (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
1N/A # it's a regexp
1N/A $ok = ($got =~ /$pattern/);
1N/A test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
1N/A } else {
1N/A $ok = ($got eq $expected);
1N/A test $num, $ok, "Expected string '$expected', got '$got'\n";
1N/A }
1N/A# print "# $num: $got\n";
1N/A}
1N/A
1N/Amy $odd_msg = '/^Odd number of elements in hash assignment/';
1N/Amy $odd_msg2 = '/^Odd number of elements in anonymous hash/';
1N/Amy $ref_msg = '/^Reference found where even-sized list expected/';
1N/A
1N/A{
1N/A my %hash = (1..3);
1N/A test_warning 1, shift @warnings, $odd_msg;
1N/A
1N/A %hash = 1;
1N/A test_warning 2, shift @warnings, $odd_msg;
1N/A
1N/A %hash = { 1..3 };
1N/A test_warning 3, shift @warnings, $odd_msg2;
1N/A test_warning 4, shift @warnings, $ref_msg;
1N/A
1N/A %hash = [ 1..3 ];
1N/A test_warning 5, shift @warnings, $ref_msg;
1N/A
1N/A %hash = sub { print "ok" };
1N/A test_warning 6, shift @warnings, $odd_msg;
1N/A
1N/A {
1N/A # "Pseudo-hashes are deprecated" warnings tested in warnings/av
1N/A no warnings 'deprecated';
1N/A
1N/A my $avhv = [{x=>1,y=>2}];
1N/A %$avhv = (x=>13,'y');
1N/A test_warning 7, shift @warnings, $odd_msg;
1N/A
1N/A %$avhv = 'x';
1N/A test_warning 8, shift @warnings, $odd_msg;
1N/A
1N/A $_ = { 1..10 };
1N/A test 9, ! @warnings, "Unexpected warning";
1N/A }
1N/A}