Changes between Version 20 and Version 21 of SandBox


Ignore:
Timestamp:
Aug 9, 2011, 2:59:38 PM (3 years ago)
Author:
bowtie
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • SandBox

    v20 v21  
    44 
    55Go ahead, edit it freely. 
     6 
     7 
     8{{{#!perl 
     9 
     10 
     11sub 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 
    659== Tickets == 
    760just adjust the item to find open defects