/[Frey]/trunk/lib/Frey/Test/Runner.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /trunk/lib/Frey/Test/Runner.pm

Parent Directory | Revision Log | View Patch Patch

-revision 503 by dpavlin,
Mon Nov 24 21:50:05 2008 UTC
+revision 1133 by dpavlin,
Tue Jun 30 15:10:55 2009 UTC
 Line 2 
 package Frey::Test::Runner;
  use Moose;
  extends 'Frey';
- with 'Frey::Web';
+ with 'Frey::Web', 'Frey::Storage';
- with 'Frey::Storage';
  use TAP::Harness;
  use TAP::Formatter::HTML;
  use Data::Dump qw/dump/;
+ use File::Slurp;
  use Frey::SVK;
  use Frey::PPI;
 Line 18 
 has tests => (
          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',
+ );
+ has test => (
+         is => 'rw',
+         isa => 'Str',
+         documentation => 'run only this single test',
+ );
+ has test_because => (
+         documentation => 'returns classes responsable for each test run',
+         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) = @_;
+ =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,
+                 silent => 1,
                  inline_css => 1,
                  inline_js  => 0,
-Line 37 
 sub as_markup {
+Line 93 
 sub as_markup {
                  formatter => $f,
          });
-         my $tests;
+         my @tests;
-         map {
+         @tests = ( $self->test ) if $self->test;
-                 $tests->{$_}->{'test modified'}++ if m{\.t$};
-         } @{ $self->tests };
+         if ( my $depends = $self->test_because ) {
+                 @tests = grep {
-         map {
+                         $_ ne '' &&
-                 if ( m{(.+)\.pm$} ) {
+                         -e $_ &&
-                         my $class = $1;
+                         ! m{$0} # break recursion
-                         $class =~ s{^lib/}{};
+                 } sort keys %{ $depends } unless @tests;
-                         $class =~ s{/}{::}g;
+         }
-                         warn "extract tests from $_ class $class";
-                         $tests->{$_}->{$class}++ foreach Frey::PPI->new( class => $class )->has_tests;
-                 }
-         } @{ $self->tests };
-         my @tests = grep {
+         $self->add_status( { test => { depends => $self->test_because } } );
-                 ! m{$0} # break recursion
-         } sort keys %$tests;
+         if ( ! @tests ) {
-         die "no tests for files ", dump( $self->tests ),dump( $tests ) unless @tests;
+                 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 );
          $self->store( 'var/test/' . time() . '.yaml', $h );
-         push @{ $self->status }, { test => $tests };
          my $html = ${ $f->html };
  #       warn $html;
          warn "got ",length($html), " bytes";
          while ( $html =~ s{(<style.+?/style>)}{}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|
-Line 80 
 sub as_markup {
+Line 138 
 sub as_markup {
                  td.results:hover ul.test-out { display: block; }
                  </style>
          |);
+         $html =~ s{<div id="menu">.+?</div>}{}sg; # remove menu which doesn't work without JavaScript
          $html =~ s{^.*<body>}{}s;
          $html =~ s{</body>.*$}{}s;
          $html =~ s{(<a class="file") href="#"(.+?)>t/(.+?)</a>}{<a target="editor" href="/editor+t/$3.t+1" name="t/$3.t" $2>$3</a>}sg;
-         return
+         $html = $self->html_links( $html );
-                 $self->editor_links( $html )
+         if ( my $depends = $self->test_because ) {
+                 $html .= qq|Test dependencies:|
                  . qq|<ul><li>|
                  . join("</li>\n<li>",
                          map {
-                                 qq|<a href="#$_"><tt>$_</tt></a> &larr; |
+                                 my $test = $_;
-                                 .
+                                 my $depends =
                                  join(' ',
                                          map {
                                                  if ( m{\s} ) {
-Line 101 
 sub as_markup {
+Line 162 
 sub as_markup {
                                                          qq|<a target="introspect" href="/$_" title="introspect">$_</a>|
  #                                                       qq|<a target="editor" href="/editor+$_+1" title="edit">$_</a>|
                                                  }
-                                         } keys %{ $tests->{$_} }
+                                         } keys %{ $depends->{$_} }
-                                 )
+                                 );
+                                 qq|<a href="?test=$test"><tt>$test</tt></a>|
+                                 . ( $depends ? qq| &larr; $depends| : '' )
+                                 ;
                          } @tests )
                  . qq|</li></ul>|
                  ;
+         } 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;
  }
+ __PACKAGE__->meta->make_immutable;
+ no Moose;
 ;

 Legend:



Removed from v.503
 


changed lines


 
Added in v.1133
 Legend:



Removed from v.503
 


changed lines


 
Added in v.1133
-Removed from v.503
+Added in v.1133

	ViewVC Help
Powered by ViewVC 1.1.26