--- trunk/lib/Frey/Test/Runner.pm 2008/11/25 13:39:44 511 +++ trunk/lib/Frey/Test/Runner.pm 2008/12/02 17:36:51 682 @@ -8,6 +8,7 @@ use TAP::Harness; use TAP::Formatter::HTML; use Data::Dump qw/dump/; +use File::Slurp; use Frey::SVK; use Frey::PPI; @@ -18,7 +19,6 @@ required => 1, lazy => 1, # FIXME ask users which tests to run default => sub { -# [ glob('t/*.t') ] # all tests [ Frey::SVK->modified ] }, documentation => 'run tests which are result of modifications or whole full tests', @@ -30,7 +30,8 @@ documentation => 'run only this single test', ); -has depends => ( +has test_because => ( + documentation => 'returns classes responsable for each test run', is => 'rw', # isa => 'HashRef[Hashref[Int]', required => 1, @@ -62,6 +63,26 @@ sub as_markup { my ($self) = @_; +=for later + + my $path = 'var/test/'; + my $running_pid = "$path/running.pid"; + + my $pid = read_file $running_pid if -e $running_pid; + if ( $pid ) { + if ( kill 0, $pid ) { + warn "ABORTING: $self allready running as pid $pid"; + return 'abort'; + } else { + warn "got $pid from $running_pid but no process alive, ignoring..."; + } + } + + write_file( $running_pid, $$ ); + warn "# started $self with pid $$ -> $running_pid"; + +=cut + my $f = TAP::Formatter::HTML->new({ # silent => 1, @@ -77,21 +98,24 @@ @tests = ( $self->test ) if $self->test; - if ( my $depends = $self->depends ) { + if ( my $depends = $self->test_because ) { @tests = grep { $_ ne '' && ! m{$0} # break recursion } sort keys %{ $depends } unless @tests; } - $self->add_status( { test => { depends => $self->depends } } ); + $self->add_status( { test => { depends => $self->test_because } } ); if ( ! @tests ) { - warn "can't find any tests ", dump( $self->tests ), " within depends ", dump( $self->depends ); - warn "running all tests instead"; - @tests = glob('t/*.t'); + warn "can't find any tests ", dump( $self->tests ), " within depends ", dump( $self->test_because ); +# warn "running all tests instead"; +# @tests = glob('t/*.t'); + @tests = ( qw{t/00-load.t t/pod.t} ); # XXX default tests } + $self->title( join(' ', @tests ) ); + warn "testing ",dump( @tests ); $h->runtests( @tests ); @@ -102,7 +126,9 @@ warn "got ",length($html), " bytes"; while ( $html =~ s{()}{}gs ) { - $self->add_head( $1 ); + my $style = $1; + $style =~ s[((?:body|html)\s+{[^}]+})][/\* $1 \*/]sg; # remove some styles + $self->add_head( $style ); } $self->add_head(qq| @@ -112,20 +138,21 @@ td.results:hover ul.test-out { display: block; } |); + $html =~ s{}{}sg; # remove menu which doesn't work without JavaScript $html =~ s{^.*}{}s; $html =~ s{.*$}{}s; $html =~ s{(t/(.+?)}{$3}sg; - $html = $self->editor_links( $html ); + $html = $self->html_links( $html ); - if ( my $depends = $self->depends ) { + if ( my $depends = $self->test_because ) { $html .= qq|Test dependencies:| . qq|| ; + } else { + warn "# test_because empty"; } - + + $self->add_icon( $1 ) if $html =~ m{class="(passed|failed)"}; + +=for later + + unlink $running_pid or die "can't remove $running_pid: $!"; + +=cut + + return $html; } 1;