[perl #54988] [PATCH] enhance t/harness (again)

[via RT]

# New Ticket Created by  Moritz Lenz 
# Please include the string:  [perl #54988]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=54988 >


Attached patch enhances t/harness, this time it offers the possibility
to call fudge on a per-file base (as requested on IRC by particle and
pmichaud, iirc).

The patch adds a --configfudge option, which (in conjunction with
--tests-from-file ) only fudges those tests which are marked with
'#fudge' at the end.

Copy the attaced configfudge.data to languages/perl6/t, cd to
languages/perl6 and then run

perl t/harness --configfudge --tests-from-file=t/configfudge.data
--keep-exit-code

for a small demonstration.

Without --configfudge the behaviour is unchanged.
Please test this on Windows and MacOS, I have no access to such systems.

If you think the implemented behaviour makes sense I'll add a bit of
documentation.

Cheers,
Moritz

-- 
Moritz Lenz
http://moritz.faui2k3.org/ |  http://perl-6.de/

Index: languages/perl6/t/harness
===================================================================
--- languages/perl6/t/harness	(revision 27887)
+++ languages/perl6/t/harness	(working copy)
@@ -22,6 +22,7 @@
 GetOptions(
         'tests-from-file=s' => \my $list_file,
         'fudge'             => \my $do_fudge,
+        'configfudge'         => \my $configfudge,
     );
 
 
@@ -29,7 +30,7 @@
 my @files = grep m/^[^-]/, @ARGV;
 
 my %accepted_tests;
-if ($list_file) {
+if ($list_file || $configfudge) {
     open(my $f, '<', $list_file) 
         or die "Can't ope file '$list_file' for reading: $!";
     my $slash = $^O eq 'MSWin32' ? '\\' : '/';
@@ -37,33 +38,58 @@
         next if m/^\s*#/;
         next unless m/\S/;
         chomp;
-        $_ =~ s/\//$slash/g;
-        $accepted_tests{"t${slash}spec${slash}$_"} = 1;
+        my ($fn, $fudgespec) = split m/\s+#/;
+        $fn = "t/spec/$fn";
+        $fn =~ s/\//$slash/g;
+        $accepted_tests{$fn} = $fudgespec;
     }
     close $f;
 }
 
-if (defined($do_fudge) || $list_file ){
-    my $impl   = 'rakudo';
-    my @tfiles = sort map { -d $_ ? all_in($_) : $_ } map glob, @files;
-    if ($list_file){
-        @tfiles = grep { $accepted_tests{$_} } @tfiles;
-        die "No tests to run!" unless @tfiles;
-    }
+# first prepare our list of files
+my @tfiles;
+if ($list_file){
+    @tfiles = map { all_in($_) } sort keys %accepted_tests;
+} else {
+    @tfiles = map { all_in($_) } sort @files;
+}
+
+# then decide if and what to fudge
+if (defined($do_fudge) || defined($configfudge)){
     if ($do_fudge){
-        my $cmd = join ' ', $^X, 't/spec/fudgeall', @pass_through_options, $impl, @tfiles;
-        print "$cmd\n";
-        $harness_args{arguments} = [ split ' ', `$cmd` ];
+        @tfiles = fudge(@tfiles);
     } else {
-        $harness_args{arguments} = [EMAIL PROTECTED];
+        my (@fudge, @nofudge);
+        for (@tfiles){
+            if ($accepted_tests{$_} eq 'fudge'){
+                push @fudge, $_;
+            } else {
+                push @nofudge, $_;
+            }
+        }
+        if (@fudge) {
+            @tfiles = sort @nofudge, fudge(@fudge);
+        }
     }
 }
 
+$harness_args{arguments} = [EMAIL PROTECTED];
+
+sub fudge {
+    my $impl   = 'rakudo';
+    my $cmd = join ' ', $^X, 't/spec/fudgeall', 
+                        @pass_through_options, $impl, @_;
+    print "$cmd\n";
+    return split ' ', `$cmd`;
+}
+
 # Stolen directly from 'prove'
 # adapted to return only files ending in '.t'
 sub all_in {
     my $start = shift;
 
+    return $start unless -d $start;
+
     my @hits = ();
 
     local *DH;
@@ -94,4 +120,3 @@
 
 eval 'use Parrot::Test::Harness %harness_args';
 
-

# this is a list of all spec tests that are supposed to pass
# on current rakudo.
# empty lines and those beginning with a # are ignored

S02-builtin_data_types/type.t #fudge
S02-literals/autoref.t        #fudge
S03-operators/not.t
S03-operators/autoincrement.t
S04-statements/until.t
S04-statements/while.t        #fudge

signature.asc
Description: PGP signature