# 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
