mvhub-dev team mailing list archive

[Dan MacNeil <dan@xxxxxxxxxx>]

Dan MacNeil has proposed merging lp:~omacneil/mvhub/improve_perltidy_t into lp:mvhub.

Requested reviews:
  MVHub devs with commit rights (mvhub-commit)
Related bugs:
  #546932 improve formatting of perltidy.t error msg
  https://bugs.launchpad.net/bugs/546932


big win is to make this test 100 times faster under some circumstances.

see commit log
-- 
https://code.launchpad.net/~omacneil/mvhub/improve_perltidy_t/+merge/27456
Your team MVHub Developers is subscribed to branch lp:mvhub.

=== removed symlink 'app-mvhub/t/perltidy.t'
=== target was '../../lib-mvhub/t/perltidy.t'
=== renamed file 'lib-mvhub/t/perltidy.t' => 'app-mvhub/t/perltidy.t'
--- lib-mvhub/t/perltidy.t	2010-03-12 15:21:20 +0000
+++ app-mvhub/t/perltidy.t	2010-06-13 21:47:23 +0000
@@ -3,19 +3,21 @@
 use strict;
 use warnings;
 
+use Carp;
 use Test::More;
 use File::Temp;
+use Test::NoWarnings;
 
 BEGIN {
     use FindBin qw($Bin);
-    chdir $Bin;
+    chdir "$Bin/../..";
 }
 
 use TestHelper;
 
 SKIP:
 {
-    my $perltidyrc = "$FindBin::Bin" . "/conf/perltidyrc";
+    my $perltidyrc = "lib-mvhub/t/conf/perltidyrc";
     eval {
         require Perl::Tidy;
         $Perl::Tidy::VERSION eq '20090616'
@@ -28,13 +30,20 @@
     }
     else {
 
-        my @perl_files = get_files(qw/*.pl *.pm *.t /);
-        @perl_files = grep { $_ !~ /blib/ } @perl_files;
-        plan tests => ( scalar @perl_files );
-
-        my $fix_msg;
+        my @perl_files;
+        if ( defined $ENV{MV_CHECK_ONLY_UNCOMMITTED} ) {
+            @perl_files = _get_uncommitted_perl_files();
+        }
+        else {
+            @perl_files = _get_all_perl_files();
+        }
+
+        plan tests => ( scalar @perl_files ) + 1;    # +1 for NoWarnings
+
+        my @files_to_fix;
 
         foreach my $file (@perl_files) {
+
             my $destination = ( File::Temp::tempfile() )[1];
             Perl::Tidy::perltidy(
                 source      => $file,
@@ -44,18 +53,51 @@
             );
 
             if (!ok(TestHelper::no_difference( $file, $destination ),
-                    "$file is all perltidy "
+                    "perltidy: $file"
                 )
                 )
             {
-                $fix_msg .= " $file";
+                push @files_to_fix, $file;
             }
 
             unlink $destination
                 or diag "failed to unlink $destination";
         }    # foreach
-        diag(
-            "\n\nto fix:\n\n \t perltidy -b $fix_msg --profile=$perltidyrc\n\n"
-        ) if $fix_msg;
+        diag( _build_fix_msg( $perltidyrc, @files_to_fix ) )
+            if scalar @files_to_fix;
     }    # else
 }    # SKIP
+
+sub _get_uncommitted_perl_files {
+
+    my @perl_files = `bzr status`;
+    chomp @perl_files;
+    @perl_files = map { s# +##; $_; } @perl_files;
+    @perl_files = grep { m/(pl|pm|t)$/; } @perl_files;
+
+    return @perl_files;
+}
+
+sub _get_all_perl_files {
+
+    my @perl_files = get_files_from( '.', qw/*.pl *.pm *.t / );
+    @perl_files = map { s#^.*lib-mvhub/t/\.\.#lib-mvhub#;  $_; } @perl_files;
+    @perl_files = map { s#^.*app-mvhub/t/\.\.#app-mvhub/#; $_; } @perl_files;
+    @perl_files = map { s#^\./##;                          $_; } @perl_files;
+
+    return @perl_files;
+}
+
+sub _build_fix_msg {
+    my $perltidyrc = shift or croak 'missing pararm: $perltidyrc';
+    my @files      = @_    or die 'missing parameter: @files';
+    my $files = join ' ', @files;
+
+    my $cmd = <<"END";
+TO FIX: 
+
+      cdw && perltidy  -b --profile=$perltidyrc $files
+       
+END
+    return $cmd;
+}