From d952250d9a34d966426cb870a53812629b111885 Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Sun, 13 Jun 2010 16:52:54 +0200 Subject: [PATCH] [App::Pls] implemented 'build' All t/subcommands/build.t tests now pass. --- lib/App/Pls.pm | 44 +++++++++++++++++++++++++++++++++++++++---- t/subcommands/build.t | 36 +++++++++++++++++++++-------------- 2 files changed, 62 insertions(+), 18 deletions(-) diff --git a/lib/App/Pls.pm b/lib/App/Pls.pm index 759b4b2..2e0892b 100644 --- a/lib/App/Pls.pm +++ b/lib/App/Pls.pm @@ -1,14 +1,15 @@ use v6; -subset State of Str where { +subset State of Str where 'gone' | 'fetched' | 'built' | 'tested' | 'installed' -}; +; enum Result ; role App::Pls::ProjectsState { method state-of($project --> State) { !!! } method set-state-of($project, State $state) { !!! } method deps-of($project) { !!! } + method reached-state($project, State $state --> Bool) { !!! } } class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState { @@ -35,6 +36,13 @@ class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState { } die "No such project: $project"; } + + method reached-state($project, $goal-state --> Bool) { + my $actual-state = self.state-of($project); + my @states = ; + my %state-levels = invert @states; + return %state-levels{$actual-state} >= %state-levels{$goal-state}; + } } role App::Pls::Fetcher { @@ -42,6 +50,7 @@ role App::Pls::Fetcher { } role App::Pls::Builder { + method build($project) { !!! } } role App::Pls::Tester { @@ -76,7 +85,10 @@ class App::Pls::Core { return failure if self!fetch-helper($dep) == failure; } - if $!fetcher.fetch($project) == success { + if $!projects.reached-state($project, 'fetched') { + return success; + } + elsif $!fetcher.fetch($project) == success { $!projects.set-state-of($project, 'fetched'); return success; } @@ -86,7 +98,31 @@ class App::Pls::Core { } method build(*@projects) { - return; + for @projects -> $project { + my %*seen-projects; + return failure + if self!fetch-helper($project) == failure; + return failure + if self!build-helper($project) == failure; + } + return success; + } + + method !build-helper($project --> Result) { + for $!projects.deps-of($project) -> $dep { + return failure + if self!build-helper($dep) == failure; + } + if $!projects.reached-state($project, 'built') { + return success; + } + elsif $!builder.build($project) == success { + $!projects.set-state-of($project, 'built'); + return success; + } + else { + return failure; + } } method test(*@projects, Bool :$ignore-deps) { diff --git a/t/subcommands/build.t b/t/subcommands/build.t index 5cdb7be..44a7ac0 100644 --- a/t/subcommands/build.t +++ b/t/subcommands/build.t @@ -7,25 +7,33 @@ my %projects = fetched => { :state }, unfetched => {}, "won't-fetch" => {}, - "won't-build" => { :state }, + "won't-build" => {}, # RAKUDO: Need quotes around keys starting with 'has-' [perl #75694] 'has-deps' => { :state, :deps }, A => { :state }, B => { :state, :deps }, C => {}, - D => { :state }, + D => { :state }, circ-deps => { :state, :deps }, E => { :state, :deps }, - dirdep-fails => { :state, :deps }, + dirdep-fails => { :state, :deps }, #' indir-fails => { :state, :deps }, ; my @actions; class Mock::Fetcher does App::Pls::Builder { + method fetch($project --> Result) { + push @actions, "fetch[$project]"; + $project eq "won't-fetch" ?? failure !! success; + } } class Mock::Builder does App::Pls::Builder { + method build($project --> Result) { + push @actions, "build[$project]"; + $project eq "won't-build" ?? failure !! success; + } } my $core = App::Pls::Core.new( @@ -46,7 +54,7 @@ given $core { @actions = (); is .state-of('unfetched'), 'gone', "State before: 'gone'"; is .build(), success, "Building unfetched project succeeded"; - is ~@actions, 'fetch[unfeched] build[unfetched]', + is ~@actions, 'fetch[unfetched] build[unfetched]', "Fetched the project before building it"; is .state-of('unfetched'), 'built', "State after of unfetched: 'built'"; @@ -60,14 +68,14 @@ given $core { # [T] Build a project; a build error occurs: Fail. @actions = (); is .build(), failure, "Won't build if build fails"; # " - is ~@actions, "fetch[won't-build] build[won't build]", "Tried building"; - is .state-of("won't-build"), 'gone', - "State after of won't-build: unchanged"; + is ~@actions, "fetch[won't-build] build[won't-build]", "Tried building"; + is .state-of("won't-build"), 'fetched', + "State after of won't-build: 'fetched'"; # [T] Build a project with dependencies: Build dependencies first. @actions = (); - is .build(), 'success', "Building project with deps succeeds"; - is ~@actions, "fetch[C] build[A] build[C] build[D] build[has-deps]", + is .build(), success, "Building project with deps succeeds"; + is ~@actions, "fetch[C] build[A] build[C] build[B] build[has-deps]", "Fetch before build, build with postorder traversal"; is .state-of('has-deps'), 'built', "State after of has-deps: built"; for -> $dep { @@ -79,14 +87,14 @@ given $core { is .build(), failure, "Building project with circ deps fails"; is ~@actions, "", "Didn't even try to build anything"; is .state-of('circ-deps'), 'fetched', "State after of circ-deps: unchanged"; - is .state-of('E'), 'fetched'; + is .state-of('E'), 'fetched', "State after of E: unchanged"; # [T] Build a project whose direct dependency fails: Fail. is .build(), failure, "Fail when direct dep fails to build"; is .state-of('dirdep-fails'), 'fetched', "State after of dirdep-fails: unchanged"; - is .state-of('will-fail'), 'fetched', - "State after of will-fail: unchanged"; + is .state-of("won't-build"), 'fetched', + "State after of won't-build: unchanged"; # [T] Build a project whose indirect dependency fails: Fail. is .build(), failure, "Fail when indirect dep fails to build"; @@ -94,6 +102,6 @@ given $core { "State after of indir-fails: unchanged"; is .state-of('dirdep-fails'), 'fetched', "State after of dirdep-fails: unchanged"; - is .state-of('will-fail'), 'fetched', - "State after of will-fail: unchanged"; + is .state-of("won't-build"), 'fetched', + "State after of won't-build: unchanged"; }