Permalink
Browse files

[tdd-harness] add for the purposes of reproducibility

  • Loading branch information...
1 parent 31fac7b commit c480714d12a787ccdc28a49f6401c029b24acff0 @masak committed Jan 25, 2010
Showing with 104 additions and 0 deletions.
  1. +104 −0 tdd-harness
View
@@ -0,0 +1,104 @@
+use v5.8;
+use strict;
+use warnings;
+
+my $loud = 0;
+my $TEST_FILE = shift or die 'Usage: tdd-harness <testfile>';
+my $SLEEP_TIME = 2;
+
+$ENV{PERL6LIB} = join ':', qw<
+ lib
+ /Users/work/hobbies/parrot/languages/rakudo
+>;
+
+my @files = qw<
+ lib/GGE/Exp.pm
+ lib/GGE/Match.pm
+ lib/GGE/OPTable.pm
+ lib/GGE/Perl6Regex.pm
+ t/03-optable.t
+ t/perl6regex/01-regex.t
+ t/perl6regex/rx_subrules
+ t/perl6regex/rx_metachars
+ t/perl6regex/rx_quantifiers
+ t/perl6regex/rx_backtrack
+ t/perl6regex/rx_charclass
+ t/perl6regex/rx_modifiers
+ t/perl6regex/rx_captures
+>;
+my %modifications = map { $_ => -M $_ } @files;
+my $checkpoint_time = time();
+
+my %mode_messages = ('implementation' => 'back to coding',
+ 'build' => 'compiling',
+ 'control' => 'testing',
+ 'checkpoint' => 'checkpoint, oh yay!');
+
+sub set_mode {
+ my ($mode) = @_;
+
+ print '=== ', uc $mode, " MODE\n";
+ $loud and system("say " . $mode_messages{$mode});
+}
+
+sub check_passes {
+ my ($file) = @_;
+
+ `perl -ne'print /^ok/ || /# TODO/ ? 1 : /^not ok/ ? 0 : ""' $file`;
+}
+
+sub compare_passes {
+ my ($new, $old) = @_;
+
+ my ($passing_new_tests, $passing_old_tests)
+ = map { /^(1*)/ and length $1 } $new, $old;
+
+ return $passing_new_tests <=> $passing_old_tests;
+}
+
+sub run_tests {
+ system( "perl6 $TEST_FILE | tee test.log" );
+ my $results = check_passes('test.log');
+ unlink('test.log');
+ return $results;
+}
+
+set_mode 'control';
+my $last_passes = run_tests();
+
+while (1) {
+ set_mode 'implementation';
+
+ WAIT:
+ while (1) {
+ sleep $SLEEP_TIME;
+ for my $file (keys %modifications) {
+ if ($modifications{$file} > -M $file) {
+ $modifications{$file} = -M $file;
+ set_mode 'build';
+ my $build_successful = !system("make");
+ last WAIT unless $build_successful;
+ set_mode 'control';
+ my $these_passes = run_tests();
+ my $cmp = compare_passes($these_passes, $last_passes);
+ if ($cmp < 0) {
+ print "++ Regression\n";
+ }
+ elsif ($cmp == 0) {
+ print "++ Nope, that wasn't it\n";
+ }
+ else {
+ set_mode 'checkpoint';
+ my $t = time() - $checkpoint_time;
+ printf "Elapsed time: %d s (%d m %d s)\n",
+ $t, $t/60, $t % 60;
+ $checkpoint_time = time();
+ sleep 4;
+ system('git ci ' . join ' ', @files);
+ $last_passes = $these_passes;
+ }
+ last WAIT;
+ }
+ }
+ }
+}

0 comments on commit c480714

Please sign in to comment.