--- trunk/lib/Frey/Test/Runner.pm 2008/11/24 17:26:47 489 +++ trunk/lib/Frey/Test/Runner.pm 2008/11/25 13:39:44 511 @@ -21,51 +21,127 @@ # [ glob('t/*.t') ] # all tests [ Frey::SVK->modified ] }, + documentation => 'run tests which are result of modifications or whole full tests', +); + +has test => ( + is => 'rw', + isa => 'Str', + documentation => 'run only this single test', +); + +has depends => ( + is => 'rw', +# isa => 'HashRef[Hashref[Int]', + required => 1, + lazy => 1, + default => sub { + my $self = shift; + my $depends; + + # collect real tests + map { + $depends->{$_}->{'test modified'}++ if m{\.t$}; + } @{ $self->tests }; + + # and tests which depend on modified classes supplied + map { + if ( m{(.+)\.pm$} ) { + my $class = $1; + $class =~ s{^lib/}{}; + $class =~ s{/}{::}g; + warn "extract tests from $_ class $class"; + $depends->{$_}->{$class}++ foreach Frey::PPI->new( class => $class )->has_tests; + } + } @{ $self->tests }; + + return $depends; + }, ); sub as_markup { my ($self) = @_; my $f = TAP::Formatter::HTML->new({ - silent => 1, +# silent => 1, inline_css => 1, - inline_js => 1, + inline_js => 0, }); my $h = TAP::Harness->new({ merge => 1, formatter => $f, }); - my @tests = - grep { ! m{$0} } # FIXME privitive way to break recursion - grep { m{\.t$} } # take just tests - map { - if ( m{(.+)\.pm$} ) { - my $class = $1; - $class =~ s{^lib/}{}; - $class =~ s{/}{::}g; - warn "extract $_ tests $class"; - Frey::PPI->new( class => $class )->has_tests; - } else { - $_ - } - } - @{ $self->tests }; + my @tests; - die "no tests for files ", dump( $self->tests ) unless @tests; + @tests = ( $self->test ) if $self->test; + + if ( my $depends = $self->depends ) { + @tests = grep { + $_ ne '' && + ! m{$0} # break recursion + } sort keys %{ $depends } unless @tests; + } + + $self->add_status( { test => { depends => $self->depends } } ); + + 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 "testing ",dump( @tests ); $h->runtests( @tests ); - $self->store( 'var/test.yaml', $h ); + $self->store( 'var/test/' . time() . '.yaml', $h ); my $html = ${ $f->html }; # warn $html; warn "got ",length($html), " bytes"; -# $html =~ s{^.*}{}s; -# $html =~ s{.*$}{}s; - return $self->editor_links( $html ); + + while ( $html =~ s{()}{}gs ) { + $self->add_head( $1 ); + } + + $self->add_head(qq| + + |); + + $html =~ s{^.*}{}s; + $html =~ s{.*$}{}s; + + $html =~ s{(t/(.+?)}{$3}sg; + + $html = $self->editor_links( $html ); + + if ( my $depends = $self->depends ) { + $html .= qq|Test dependencies:| + . qq|| + ; + } + } 1;