1
exercism fetch perl5 queen-attack

queen.t

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
#!/usr/bin/env perl
use strict;
use warnings;

use Test::More;
use JSON qw(from_json);
use FindBin;
my $dir;
BEGIN { $dir = $FindBin::Bin . '/' };
use lib $dir;

my $module = $ENV{EXERCISM} ? 'Example' : 'Queens';

my $cases_file = "${dir}cases.json";
my $cases;
if (open my $fh, '<', $cases_file) {
    local $/ = undef;
    $cases = from_json scalar <$fh>;
} else {
    die "Could not open '$cases_file' $!";
}
#diag explain $cases;

my  $tests = 3;
foreach my $c (@$cases) {
	foreach my $bo (@{ $c->{boards} }) {
		$tests += keys(%$bo) - 1;
		$tests++ if not exists $bo->{exception};
	}
}
plan tests => $tests;

ok -e "${dir}${module}.pm", "missing $module.pm"
    or BAIL_OUT("You need to create a class called $module.pm with a constructor called new.");

eval "use $module";
ok !$@, "Cannot load $module.pm"
    or BAIL_OUT("Does $module.pm compile?  Does it end with 1; ? ($@)");

can_ok($module, 'new') or BAIL_OUT("Missing package $module; or missing sub new()");

foreach my $c (@$cases) {
	foreach my $board (@{ $c->{boards} }) {
        eval {
	        $board->{res} = $module->new(%{ $board->{params} });
        };
		if ($@) {
        	$board->{res} = { exception => $@ };
		}
    }
	foreach my $board (@{ $c->{boards} }) {
        if ($board->{exception}) {
			like $board->{res}{exception}, qr{^$board->{exception}}, "$c->{name} exception";
		} else {
			ok !$board->{res}{exception}, "$c->{name} no exception" or do {
				diag $board->{res}{exception};
				next;
			};
		}
	    if ($board->{white}) {
		    is_deeply $board->{res}->white, $board->{white}, "$c->{name} white";
	    }
	    if ($board->{black}) {
		    is_deeply $board->{res}->black, $board->{black}, "$c->{name} black";
	    }
        if ($board->{board}) {
            my $expected = join("\n", @{ $board->{board} }) . "\n";
            is $board->{res}->to_string, $expected , "$c->{name} board";
        }
        if (exists $board->{attack}) {
        	if ($board->{attack}) {
                ok $board->{res}->can_attack, "$c->{name} can attack";
			} else {
                ok !$board->{res}->can_attack, "$c->{name} can NOT attack";
			}
        }
    }
}


#done_testing();