some WinCE compilers require a little correction

[perl5.git] / t / op / hashwarn.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}

use strict;
use warnings;

use vars qw{ @warnings };

BEGIN {
    $SIG{'__WARN__'} = sub { push @warnings, @_ };
    $| = 1;
    print "1..9\n";
}

END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }

sub test ($$;$) {
    my($num, $bool, $diag) = @_;
    if ($bool) {
	print "ok $num\n";
	return;
    }
    print "not ok $num\n";
    return unless defined $diag;
    $diag =~ s/\Z\n?/\n/;			# unchomp
    print map "# $num : $_", split m/^/m, $diag;
}

sub test_warning ($$$) {
    my($num, $got, $expected) = @_;
    my($pattern, $ok);
    if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
	(undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
	    # it's a regexp
	    $ok = ($got =~ /$pattern/);
	    test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
    } else {
	$ok = ($got eq $expected);
	test $num, $ok, "Expected string '$expected', got '$got'\n";
    }
#   print "# $num: $got\n";
}

my $odd_msg = '/^Odd number of elements in hash assignment/';
my $odd_msg2 = '/^Odd number of elements in anonymous hash/';
my $ref_msg = '/^Reference found where even-sized list expected/';

{
    my %hash = (1..3);
    test_warning 1, shift @warnings, $odd_msg;

    %hash = 1;
    test_warning 2, shift @warnings, $odd_msg;

    %hash = { 1..3 };
    test_warning 3, shift @warnings, $odd_msg2;
    test_warning 4, shift @warnings, $ref_msg;

    %hash = [ 1..3 ];
    test_warning 5, shift @warnings, $ref_msg;

    %hash = sub { print "ok" };
    test_warning 6, shift @warnings, $odd_msg;

    # Old pseudo-hash syntax, now removed.
    my $avhv = [{x=>1,y=>2}];
    eval {
        %$avhv = (x=>13,'y');
    };
    test 7, $@ =~ /^Not a HASH reference/;

    # Old pseudo-hash syntax, since removed.
    eval {
        %$avhv = 'x';
    };
    test 8, $@ =~ /^Not a HASH reference/;

    $_ = { 1..10 };
    test 9, ! @warnings, "Unexpected warning";
}