Skip to content

Commit

Permalink
[App::Pls] implemented 'test'
Browse files Browse the repository at this point in the history
All t/subcommands/test.t tests now pass.
  • Loading branch information
Carl Masak committed Jun 13, 2010
1 parent d952250 commit 07dcc69
Show file tree
Hide file tree
Showing 2 changed files with 51 additions and 5 deletions.
34 changes: 33 additions & 1 deletion lib/App/Pls.pm
Expand Up @@ -54,6 +54,7 @@ role App::Pls::Builder {
}

role App::Pls::Tester {
method test($project) { !!! }
}

role App::Pls::Installer {
Expand All @@ -63,6 +64,7 @@ class App::Pls::Core {
has App::Pls::ProjectsState $!projects;
has App::Pls::Fetcher $!fetcher;
has App::Pls::Builder $!builder;
has App::Pls::Tester $!tester;

method state-of($project) {
return $!projects.state-of($project);
Expand Down Expand Up @@ -126,7 +128,37 @@ class App::Pls::Core {
}

method test(*@projects, Bool :$ignore-deps) {
return;
for @projects -> $project {
my %*seen-projects;
return failure
if self!fetch-helper($project) == failure;
return failure
if self!build-helper($project) == failure;
# RAKUDO: an unspecified $ignore-deps should be False, is Any
return failure
if self!test-helper($project, :ignore-deps(?$ignore-deps))
== failure;
}
return success;
}

method !test-helper($project, Bool :$ignore-deps --> Result) {
unless $ignore-deps {
for $!projects.deps-of($project) -> $dep {
return failure
if self!test-helper($dep) == failure;
}
}
if $!projects.reached-state($project, 'tested') {
return success;
}
elsif $!tester.test($project) == success {
$!projects.set-state-of($project, 'tested');
return success;
}
else {
return failure;
}
}

method install(*@projects, Bool :$force, Bool :$skip-test) {
Expand Down
22 changes: 18 additions & 4 deletions t/subcommands/test.t
Expand Up @@ -26,12 +26,24 @@ my %projects =
my @actions;

class Mock::Fetcher does App::Pls::Fetcher {
method fetch($project) {
push @actions, "fetch[$project]";
$project eq "won't-fetch" ?? failure !! success;
}
}

class Mock::Builder does App::Pls::Builder {
method build($project) {
push @actions, "build[$project]";
$project ~~ /^won\'t\-build/ ?? failure !! success;
}
}

class Mock::Tester does App::Pls::Tester {
method test($project) {
push @actions, "test[$project]";
$project eq "won't-test" ?? failure !! success;
}
}

my $core = App::Pls::Core.new(
Expand Down Expand Up @@ -70,6 +82,7 @@ given $core {
is .state-of("unfetched"), 'tested', "State after: 'tested'";

# [T] Test an unfetched project; fetch fails. Fail.
@actions = ();
is .test(<won't-fetch>), failure, "Won't fetch and thus won't test"; #'
is ~@actions, "fetch[won't-fetch]",
"Tried fetching, not building or testing";
Expand All @@ -90,7 +103,7 @@ given $core {
@actions = ();
is .test(<has-deps>), success, "Test a project with dependencies";
is ~@actions,
'fetch[C] build[D] build[B] '
'fetch[C] build[C] build[D] build[B] '
~ 'test[A] test[C] test[D] test[B] test[has-deps]',
"Fetch first, then build (postorder), then test (postorder)";
is .state-of("has-deps"), 'tested', "State after of has-deps: 'tested'";
Expand All @@ -102,9 +115,10 @@ given $core {
# dependencies: test only the project, do not fetch/build dependencies
@actions = ();
is .test(<ignore-deps>, :ignore-deps), success, "Test-ignore-deps works";
is ~@actions, 'test[ignore-deps]', "Only ignore-deps is tested";
is ~@actions, 'fetch[E] build[E] build[F] test[ignore-deps]',
"Only ignore-deps is tested";
is .state-of("ignore-deps"), 'tested', "State after: 'tested'";
is .state-of("E"), 'gone', "State after of E: unchanged";
is .state-of("F"), 'fetched', "State after of F: unchanged";
is .state-of("E"), 'built', "State after of E: 'built'";
is .state-of("F"), 'built', "State after of F: 'built'";
is .state-of("G"), 'built', "State after of G: unchanged";
}

0 comments on commit 07dcc69

Please sign in to comment.