Skip to content

Instantly share code, notes, and snippets.

@afresh1 afresh1/reprove.pl
Last active Jun 29, 2016

Embed
What would you like to do?
This script watches your tests and your files and re-runs "prove" to help with perl TDD -- http://perldoc.perl.org/prove.html
#!/usr/bin/perl
# Copyright (c) 2015 Andrew Fresh <andrew@afresh1.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
use strict;
use warnings;
use 5.010;
use File::Find;
my %options_that_take_arguments = map { $_ => 1 }
qw( I P M e exec harness formatter source a archive j jobs state rc );
open my $prove, '-|', 'prove', '-D', @ARGV or die $!;
my %test_files = map { s/\r?\n//; $_ => 1 } <$prove>;
close $prove or die $!;
my @flags;
my @search_paths;
while (@ARGV) {
$_ = shift @ARGV;
if (/(^--(\w+)(=.*)?)$/) {
push @flags, $1;
push @flags, shift @ARGV
if $options_that_take_arguments{$2} and not defined $3;
}
elsif (/(^-\w*(\w)(=.*)?)$/) {
push @flags, $1;
push @flags, shift @ARGV
if $options_that_take_arguments{$2} and not defined $3;
}
else { push @search_paths, $_ }
}
push @search_paths, keys %test_files;
push @search_paths, split /\s+/, $ENV{WATCH_FILES} || '';
my %watch_files;
find( sub {
return unless -f $_;
return if index( $_, '.' ) == 0; # skip dotfiles
$watch_files{$File::Find::name} = ( stat(_) )[9];
}, grep {-e} 'lib', @search_paths
);
run_tests();
# brute force file watcher
while (1) {
sleep 3;
check_for_updates();
}
sub run_tests {
my @tests = grep { is_test($_) } @_;
@tests = keys %test_files unless @tests;
say "prove @flags @tests";
system 'prove', @flags, @tests;
}
sub is_test {
my ($file) = @_;
return $test_files{$file};
}
sub check_for_updates {
my @changed;
my %new;
foreach my $file ( keys %watch_files ) {
next unless -f $file;
$new{$file} = ( stat(_) )[9];
if ( $new{$file} != $watch_files{$file} ) {
warn "[$file] $new{$file} != $watch_files{$file}\n";
push @changed, $file;
}
}
%watch_files = %new;
return unless @changed;
return run_tests(@changed);
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.