perl6 via RT wrote:
> 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.
The attached patch is a revised version which assumes fudging to be the
default (as discussed with patrick and particle on #parrot). Fudging can
now be disabled with a #pure comment at the end of the line.
The patch also enables that for the new 'localtest' make target.
Cheers,
Moritz
--
Moritz Lenz
http://moritz.faui2k3.org/ | http://perl-6.de/
Index: t/harness
===================================================================
--- t/harness (revision 27895)
+++ 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{$_} =~ m/^(?:pure|raw)$/){
+ push @nofudge, $_;
+ } else {
+ push @fudge, $_;
+ }
+ }
+ 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';
-
Index: config/makefiles/root.in
===================================================================
--- config/makefiles/root.in (revision 27895)
+++ config/makefiles/root.in (working copy)
@@ -165,7 +165,7 @@
localtest: t/localtest.data
$(PERL) t/harness \
- --fudge \
+ --configfudge \
--tests-from-file=t/localtest.data \
--keep-exit-code \
t/spec/ \
