Skip to content

Commit c60dcd1

Browse files
ronaldxsronaldxs
authored
Merge pull request #231 from ronaldxs/fudgeandrun
Fudgeandrun move to roast
2 parents b71c24b + d978aee commit c60dcd1

23 files changed

+402
-26
lines changed

‎fudgeall

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,9 @@ print join(' ',
4646
if ( $_ !~ m/\.$platform$/ ) {
4747
my $cmd = "$^X \"$fudge\" @opts $platform $_";
4848
chomp( $pick = `$cmd` );
49+
if ($?) {
50+
exit($? == -1 or $? & 127 ? $? : $? >> 8);
51+
}
4952
}
5053
defined $pick ? $pick : ();
5154
} @ARGV

‎fudgeandrun

Lines changed: 170 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,170 @@
1+
#! /usr/bin/env perl
2+
use strict;
3+
use warnings;
4+
5+
######################################################################
6+
# Fudge a test and run the fudged result.
7+
#
8+
# Historically, this was part of the Rakudo development repository
9+
# and it will check for local perl6 and fudge(all?) executables first
10+
# and give them priority over executables on path.
11+
######################################################################
12+
13+
use Getopt::Long;
14+
use List::Util qw(first);
15+
use File::Spec::Functions qw(canonpath splitpath catfile);
16+
use Cwd 'cwd';
17+
18+
GetOptions(
19+
'impl=s' => \my $impl_p,
20+
'backend=s' => \my $backend,
21+
'impl-cmd=s' => \my $impl_cmd,
22+
'version=s' => \my $version,
23+
'quiet' => \my $opt_q,
24+
'six|6' => \my $opt_6,
25+
);
26+
27+
unless (@ARGV) {
28+
die <<"USAGE";
29+
Usage: $0 [options] testfilename ...
30+
31+
Options:
32+
--impl=implemention
33+
Default extracted from perl6 \$*PERL and \$*VM variables.
34+
implementation may be just name or compiler.backend like rakudo.jvm
35+
36+
--backend=(moar|jvm|other)
37+
specify implementation as
38+
compiler from \$*PERL.compiler.name suffixed by ".\$backend"
39+
40+
--impl-cmd
41+
Specify command other than "perl6" to run implementation
42+
rakudo is grandfathered to "perl6-m" for rakudo.moar and
43+
"perl6-j" for rakudo.jvm
44+
45+
--version
46+
version like v6.0.0+ for fudging
47+
48+
--quiet
49+
By default fudged tests are run with "prove -v". This option
50+
turns off the "-v"
51+
52+
--six|6
53+
Runs fudged tests with perl6 instead of prove.
54+
55+
USAGE
56+
}
57+
58+
# decide between local and PATH perl
59+
my $p6 = catfile('.', 'perl6');
60+
$p6 = 'perl6' unless -x $p6;
61+
62+
# implementation and compiler
63+
my $impl;
64+
if ($impl_p) {
65+
$impl = lc $impl_p;
66+
}
67+
else {
68+
# windows / cross platform needs -e "" with EVAL and \c[DOLLAR SIGN]
69+
$impl = `$p6 -e "EVAL qq/say \\c[DOLLAR SIGN]*PERL.compiler.name, '.', \\c[DOLLAR SIGN]*VM.name/" 2>&1`;
70+
die capture_error($p6, $impl) if $?;
71+
chomp($impl);
72+
}
73+
my ($compiler, $impl_backend) = $impl =~ /([^.]*)(?:\.(.*))?/;
74+
75+
if ($backend) {
76+
$backend = lc $backend;
77+
if (not $impl_p or $impl_p eq $compiler) {
78+
$impl = "$compiler.$backend";
79+
}
80+
else {
81+
die "Confused by backend from both --impl and --backend"
82+
}
83+
warn "Unsupported backed '$backend'. Known backends: jvm, moar\n"
84+
if $backend !~ /^(?:jvm|moar)$/;
85+
}
86+
87+
my @OPTS = (
88+
'--keep-exit-code',
89+
$version ? "--version=$version" : (),
90+
$impl
91+
);
92+
93+
my @already_fudged; # test directories may also have already fudged files
94+
95+
for (my $i = 0; $i < @ARGV; $i++) {
96+
if (! -e $ARGV[ $i ]) { # invoking from rakudo/impl repository ?
97+
my $spec = canonpath("t/spec/$ARGV[ $i ]");
98+
$ARGV[ $i ] = $spec if -e $spec;
99+
}
100+
101+
die "fudging does not handle directories like $ARGV[ $i ]\n",
102+
" try shell glob ('*')\n" if -d $ARGV[ $i ];
103+
104+
my $back = $backend || $impl_backend || ''; # '' matches trailing dot '.'
105+
if ($ARGV[$i] =~ /(?:\.(?:\Q$compiler\E|\Q$back\E|rakudo|jvm|moar))+$/) {
106+
push @already_fudged, splice @ARGV, $i--, 1;
107+
}
108+
}
109+
110+
@already_fudged = grep { # ignore files we will generate with fudge
111+
my $fudged = $_;
112+
not first { /\.t$/ and $fudged eq substr($_, 0, -1) . $impl } @ARGV
113+
} @already_fudged;
114+
115+
# look for fudge in spec checkout, then root of roast repo, then PATH
116+
my ($fudger) = first { -e }
117+
canonpath('t/spec/fudgeall'), catfile('.', 'fudgeall');
118+
$fudger //= 'fudgeall';
119+
my $nt = `$^X $fudger @OPTS @ARGV 2>&1`;
120+
die capture_error($fudger, $nt) if $?;
121+
122+
# uninstalled rakudo doesn't know how to find Test.pm
123+
# ... or any other modules
124+
my $pwd = cwd();
125+
$ENV{PERL6LIB}="$pwd/lib";
126+
127+
if ($impl_cmd) {
128+
$impl_cmd = qq/"$impl_cmd"/ if $impl_cmd =~ /\s/;
129+
}
130+
else {
131+
$impl_cmd = $p6;
132+
133+
# grandfather -m and -j for rakudo backend - not rakudo use --impl-cmd
134+
$impl_cmd .= '-j' if ( ($backend // '') eq 'jvm' and $impl =~ /\.moar/ );
135+
$impl_cmd .= '-m' if ( ($backend // '') eq 'moar' and $impl =~ /\.jvm/ );
136+
}
137+
138+
if ($opt_6) {
139+
system($impl_cmd, split(' ', $nt), @already_fudged);
140+
}
141+
else {
142+
system( 'prove', ($opt_q ? () : '-v'), "-e$impl_cmd",
143+
split(' ', $nt), @already_fudged
144+
);
145+
}
146+
die capture_error($opt_6 ? $impl_cmd : "prove '-e$impl_cmd'", $!) if $?;
147+
148+
my $already_fudge_warn = "Some files were already fudged" if @already_fudged;
149+
$already_fudge_warn .= " and were run after other tests"
150+
if @already_fudged and @ARGV;
151+
warn "\n$already_fudge_warn\n\n" if $already_fudge_warn;
152+
153+
######################################################################
154+
# We shell out for some commands and usually don't expect errors,
155+
# but if there is an error would like helpful message
156+
######################################################################
157+
sub capture_error {
158+
my ($cmd, $output) = @_;
159+
my $rc = $? == -1 ? -1
160+
: $? & 127 ? 'signal ' . $? & 127
161+
: $? >> 8;
162+
my $err = $! || $output if $?; # undef warn unless $? - wy were we called?
163+
164+
return <<"EO_ERR"
165+
Could not run $cmd
166+
System rc: $rc
167+
error: $err
168+
EO_ERR
169+
}
170+

‎t/01-implname.in

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
1-
plan 6;
1+
use v6;
2+
use Test;
3+
4+
plan 9;
25

36
is 2**2, 4;
47
#?impl-1 todo 'NYI'
58
is 2+2, 4;
69
#?impl-2 skip 'NYI'
710
{
8-
is "Life, the Universe, and Everything".WHY, 42;
11+
is "Life, the Universe and Everything".WHY, 42;
912
is 42.WHAT, Int, 'some reason';
1013
}
1114
#?impl-1 2 todo 'NYI'
@@ -16,3 +19,6 @@ is 3*4, 12;
1619
#?impl-2 1 todo 'NYI'
1720
is 2-2, 0;
1821
is 3*4, 12;
22+
23+
#?impl-1.backend todo 'NYI'
24+
is +1, 1;

‎t/01-implname.out_impl-1

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
1-
plan 6;
1+
use v6;
2+
use Test;
3+
4+
plan 9;
25

36
is 2**2, 4;
47
#?impl-1 todo 'NYI'
58
todo('NYI'); is 2+2, 4;
69
#?impl-2 skip 'NYI'
710
{
8-
is "Life, the Universe, and Everything".WHY, 42;
11+
is "Life, the Universe and Everything".WHY, 42;
912
is 42.WHAT, Int, 'some reason';
1013
}
1114
#?impl-1 2 todo 'NYI'
@@ -17,5 +20,8 @@ todo('NYI'); is 3*4, 12;
1720
todo('NYI'); is 2-2, 0;
1821
todo('NYI'); is 3*4, 12;
1922

23+
#?impl-1.backend todo 'NYI'
24+
is +1, 1;
25+
2026
say "# FUDGED!";
2127
exit(1);

‎t/01-implname.out_impl-1.backend

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
use v6;
2+
use Test;
3+
4+
plan 9;
5+
6+
is 2**2, 4;
7+
#?impl-1 todo 'NYI'
8+
todo('NYI'); is 2+2, 4;
9+
#?impl-2 skip 'NYI'
10+
{
11+
is "Life, the Universe and Everything".WHY, 42;
12+
is 42.WHAT, Int, 'some reason';
13+
}
14+
#?impl-1 2 todo 'NYI'
15+
#?impl-2 2 todo 'NYI'
16+
todo('NYI'); is 2-2, 0;
17+
todo('NYI'); is 3*4, 12;
18+
#?impl-1 2 todo 'NYI'
19+
#?impl-2 1 todo 'NYI'
20+
todo('NYI'); is 2-2, 0;
21+
todo('NYI'); is 3*4, 12;
22+
23+
#?impl-1.backend todo 'NYI'
24+
todo('NYI'); is +1, 1;
25+
26+
say "# FUDGED!";
27+
exit(1);

‎t/01-implname.out_impl-2

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
1-
plan 6;
1+
use v6;
2+
use Test;
3+
4+
plan 9;
25

36
is 2**2, 4;
47
#?impl-1 todo 'NYI'
58
is 2+2, 4;
69
#?impl-2 skip 'NYI'
710
skip('NYI', 2);# {
8-
# is "Life, the Universe, and Everything".WHY, 42;
11+
# is "Life, the Universe and Everything".WHY, 42;
912
# is 42.WHAT, Int, 'some reason';
1013
# }
1114
#?impl-1 2 todo 'NYI'
@@ -17,5 +20,8 @@ todo('NYI'); is 3*4, 12;
1720
todo('NYI'); is 2-2, 0;
1821
is 3*4, 12;
1922

23+
#?impl-1.backend todo 'NYI'
24+
is +1, 1;
25+
2026
say "# FUDGED!";
2127
exit(1);

‎t/02-version.in

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
1+
use v6;
2+
use Test;
3+
14
plan 8;
25

36
is 2**2, 4;
47
#?v6.0.0
58
is 2+2, 4;
69
#?v6.0.5+ 'GH issue #xyz'
710
{
8-
is "Life, the Universe, and Everything".WHY, 42;
11+
is "Life, the Universe and Everything".WHY, 42;
912
is 42.WHAT, Int, 'some reason';
1013
}
1114
#?v6.0.0..v6.0.2 2

‎t/02-version.out_v6.0.0

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
1+
use v6;
2+
use Test;
3+
14
plan 8;
25

36
is 2**2, 4;
47
#?v6.0.0
58
is 2+2, 4;
69
#?v6.0.5+ 'GH issue #xyz'
710
skip('GH issue #xyz', 2);# {
8-
# is "Life, the Universe, and Everything".WHY, 42;
11+
# is "Life, the Universe and Everything".WHY, 42;
912
# is 42.WHAT, Int, 'some reason';
1013
# }
1114
#?v6.0.0..v6.0.2 2

‎t/02-version.out_v6.0.3

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1+
use v6;
2+
use Test;
3+
14
plan 8;
25

36
is 2**2, 4;
@@ -6,7 +9,7 @@ skip('Version v6.0.0 required', 1); # { is 2+2, 4;
69
# }
710
#?v6.0.5+ 'GH issue #xyz'
811
skip('GH issue #xyz', 2);# {
9-
# is "Life, the Universe, and Everything".WHY, 42;
12+
# is "Life, the Universe and Everything".WHY, 42;
1013
# is 42.WHAT, Int, 'some reason';
1114
# }
1215
#?v6.0.0..v6.0.2 2

‎t/02-version.out_v6.1.0

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1+
use v6;
2+
use Test;
3+
14
plan 8;
25

36
is 2**2, 4;
@@ -6,7 +9,7 @@ skip('Version v6.0.0 required', 1); # { is 2+2, 4;
69
# }
710
#?v6.0.5+ 'GH issue #xyz'
811
{
9-
is "Life, the Universe, and Everything".WHY, 42;
12+
is "Life, the Universe and Everything".WHY, 42;
1013
is 42.WHAT, Int, 'some reason';
1114
}
1215
#?v6.0.0..v6.0.2 2

0 commit comments

Comments
 (0)