| | 6 | |
| | 7 | |
| | 8 | {{{#!perl |
| | 9 | |
| | 10 | |
| | 11 | sub on_run_this_test { |
| | 12 | my $self = shift; |
| | 13 | my $document = $self->current->document; |
| | 14 | unless ($document) { |
| | 15 | return $self->error( Wx::gettext("No document open") ); |
| | 16 | } |
| | 17 | |
| | 18 | # TO DO probably should fetch the current project name |
| | 19 | my $filename = defined( $document->{file} ) ? $document->{file}->filename : undef; |
| | 20 | unless ($filename) { |
| | 21 | return $self->error( Wx::gettext("Current document has no filename") ); |
| | 22 | } |
| | 23 | unless ( $filename =~ /\.t$/ ) { |
| | 24 | return $self->error( Wx::gettext("Current document is not a .t file") ); |
| | 25 | } |
| | 26 | |
| | 27 | # Find the project |
| | 28 | my $project_dir = $document->project_dir; |
| | 29 | unless ($project_dir) { |
| | 30 | return $self->error( Wx::gettext("Could not find project root") ); |
| | 31 | } |
| | 32 | |
| | 33 | my $dir = Cwd::cwd; |
| | 34 | chdir $project_dir; |
| | 35 | require File::Which; |
| | 36 | my $prove = File::Which::which('prove'); |
| | 37 | if (Padre::Constant::WIN32) { |
| | 38 | |
| | 39 | # This is needed since prove does not work with path containing |
| | 40 | # spaces. Please see ticket:582 |
| | 41 | require File::Temp; |
| | 42 | my $tempfile = File::Temp->new( UNLINK => 0 ); |
| | 43 | print $tempfile $filename; |
| | 44 | close $tempfile; |
| | 45 | |
| | 46 | my $things_to_test = $tempfile->filename; |
| | 47 | $self->run_command(qq{"$prove" - -lv < "$things_to_test"}); |
| | 48 | } else { |
| | 49 | $self->run_command("$prove -lv $filename"); |
| | 50 | } |
| | 51 | chdir $dir; |
| | 52 | } |
| | 53 | |
| | 54 | |
| | 55 | }}} |
| | 56 | |
| | 57 | |
| | 58 | |
