Skip to content

Commit

Permalink
Spawn procs in the same location
Browse files Browse the repository at this point in the history 
Adds :%proc-args to Test::Util, which passes through its
options to shell ala `shell( ..., |%proc-args )`. This allows
commands that get spawned to know any relative paths used will
point to the expected location (regardless if run from rakudo/
or roast/).
  • Loading branch information
@ugexe
ugexe committed Nov 19, 2017
1 parent 175e3af commit 1b0a473
Show file tree
Hide file tree
Showing 2 changed files with 57 additions and 40 deletions.
93 changes: 55 additions & 38 deletions S10-packages/precompilation.t
View file
Expand Up @@ -10,8 +10,11 @@ my $precomp-ext := $*VM.precomp-ext;
my $precomp-target := $*VM.precomp-target;
my @precomp-paths;

my @precompiled = Test::Util::run( q:to"--END--").lines;
use lib <t/spec/packages packages>;
BEGIN my $run-cwd = $?FILE.IO.parent(2).IO;

my @precompiled = Test::Util::run( :proc-args{:cwd($run-cwd)},
q:to"--END--").lines;
use lib <packages>;
for <C A B> {
my $comp-unit = $*REPO.need(CompUnit::DependencySpecification.new(:short-name("Example::$_")));
Expand All @@ -22,8 +25,9 @@ is @precompiled.elems, 3;
is $_, 'True' for @precompiled;

# RT #122773
my @keys = Test::Util::run( q:to"--END--").lines;
use lib <t/spec/packages packages>;
my @keys = Test::Util::run( :proc-args{:cwd($run-cwd)},
q:to"--END--").lines;
use lib <packages>;
use Example::A;
use Example::B;

Expand All @@ -33,8 +37,9 @@ my @keys = Test::Util::run( q:to"--END--").lines;
#?rakudo.jvm todo 'got: $["B", "C"]'
is-deeply @keys, [<A B C>], 'Diamond relationship';

my @precompiled2 = Test::Util::run( q:to"--END--").lines;
use lib <t/spec/packages packages>;
my @precompiled2 = Test::Util::run( :proc-args{:cwd($run-cwd)},
q:to"--END--").lines;
use lib <packages>;
for <T P D N S B G K C E F H R A U> {
my $comp-unit = $*REPO.need(CompUnit::DependencySpecification.new(:short-name("Example2::$_")));
Expand All @@ -45,9 +50,10 @@ is @precompiled2.elems, 15;
is $_, 'True' for @precompiled2;

# RT #123272
my @keys2 = Test::Util::run( q:to"--END--").lines;
my @keys2 = Test::Util::run( :proc-args{:cwd($run-cwd)},
q:to"--END--").lines;
use v6;
use lib <t/spec/packages packages>;
use lib <packages>;
use Example2::T;

use Example2::G;
Expand All @@ -64,13 +70,14 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
#?rakudo.moar todo 'RT #122896'
{
is_run
'use lib <t/spec/packages packages>;
'use lib <packages>;
use Example::C;
f();',
{ err => '',
out => '',
status => 0,
},
:proc-args{:cwd($run-cwd)},
'precompile exported cached sub';
}

Expand Down Expand Up @@ -100,8 +107,9 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';

#RT #123276
{
my @precompiled = Test::Util::run( q:to"--END--").lines;
use lib <t/spec/packages packages>;
my @precompiled = Test::Util::run( :proc-args{:cwd($run-cwd)},
q:to"--END--").lines;
use lib <packages>;
my $name = 'RT123276';
Expand All @@ -115,12 +123,13 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
is @precompiled.elems, 3, "tried to precompile all 3 modules";
is $_, 'True' for @precompiled;
my @keys = Test::Util::run( q:to"--END--").lines;
my @keys = Test::Util::run( :proc-args{:cwd($run-cwd)},
q:to"--END--").lines;
use lib <t/spec/packages packages>;
use RT123276::B::C1;
use RT123276::B::C2;
say RT123276::B::C1.^methods.grep( *.name ne "BUILDALL" )
--END--
--END--
#RT #123276
is-deeply @keys, [<(foo)>], 'RT123276';
Expand All @@ -134,7 +143,7 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
{
my $module-name-a = 'InternArrayA';
my $output-path-a = "t/spec/packages/" ~ $module-name-a ~ '.pm.' ~ $precomp-ext;
my $output-path-a = $run-cwd.child("packages/" ~ $module-name-a ~ '.pm.' ~ $precomp-ext);
unlink $output-path-a; # don't care if failed
is_run
'my constant VALUE = array[uint32].new;
Expand All @@ -147,11 +156,13 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
'--target', $precomp-target,
'--output', $output-path-a,
],
:proc-args{:cwd($run-cwd)},
"precomp of native array parameterization intern test (a)";
ok $output-path-a.IO.e, "did we create a $output-path-a";
my $module-name-b = 'InternArrayB';
my $output-path-b = "t/spec/packages/" ~ $module-name-b ~ '.pm.' ~ $precomp-ext;
my $output-path-b = $run-cwd.child("packages/" ~ $module-name-b ~ '.pm.' ~ $precomp-ext);
unlink $output-path-b; # don't care if failed
Expand All @@ -166,6 +177,7 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
'--target', $precomp-target,
'--output', $output-path-b,
],
:proc-args{:cwd($run-cwd)},
"precomp of native array parameterization intern test (b)";
ok $output-path-b.IO.e, "did we create a $output-path-b";
Expand All @@ -178,7 +190,9 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
out => "True",
status => 0,
},
:compiler-args['-I', 't/spec/packages'],
:proc-args{:cwd($run-cwd)},
:compiler-args['-I', 'packages'],
'precompile load of both and identity check passed';
unlink $_ for $output-path-a, $output-path-b; # don't care if failed
Expand All @@ -205,16 +219,17 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
err => { not $_ ~~ / ( "SORRY!" .*) ** 2 / },
status => { $_ != 0 },
},
:compiler-args['-I', 't/spec/packages', '-M', 'RT127176'],
:compiler-args['-I', 'packages', '-M', 'RT127176'],
:proc-args{:cwd($run-cwd)},
'no duplicate compilation error';
}
# RT #128156
{
# precompile it in a different process
run $*EXECUTABLE,'-I','t/spec/packages','-e','use RT128156::One;';
run :cwd($run-cwd), $*EXECUTABLE,'-I','packages','-e','use RT128156::One;';
# trigger recompilation
my $trigger-file = 't/spec/packages/RT128156/Two.pm6'.IO;
my $trigger-file = $run-cwd.child('packages/RT128156/Two.pm6');
$trigger-file.IO.spurt($trigger-file.slurp);
my $comp-unit = $*REPO.need(CompUnit::DependencySpecification.new(:short-name<RT128156::One>));
ok $comp-unit.handle.globalish-package<RT128156>.WHO<One Two Three>:exists.all,
Expand All @@ -223,24 +238,24 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
# Run another test where a source file is change after precompilation.
# The dependency layout is: A -> B -> C -> D
# `-> C -> D
my $before = run $*EXECUTABLE,'-I','t/spec/packages/RT128156','-M','A','-e','';
$trigger-file = 't/spec/packages/RT128156/C.pm6'.IO;
$trigger-file.IO.spurt($trigger-file.slurp);
my $after = run $*EXECUTABLE,'-I','t/spec/packages/RT128156','-M','A','-e','';
my $before = run :cwd($run-cwd), $*EXECUTABLE,'-I','packages/RT128156','-M','A','-e','';
$trigger-file = $run-cwd.child('packages/RT128156/C.pm6');
$trigger-file.spurt($trigger-file.slurp);
my $after = run :cwd($run-cwd), $*EXECUTABLE,'-I','packages/RT128156','-M','A','-e','';
is $before.status, 0, 'Can precompile modules before touching source file';
is $after.status, 0, 'Can precompile modules after touching source file';
}
# RT #128156 (another)
{
# Test file content actually changing (so that the precomp SHA changes)
run $*EXECUTABLE,'-I','t/spec/packages','-e','need RT128156::Top1; need RT128156::Top2;';
my $trigger-file = 't/spec/packages/RT128156/Needed.pm6';
run :cwd($run-cwd), $*EXECUTABLE,'-I','packages','-e','need RT128156::Top1; need RT128156::Top2;';
my $trigger-file = $run-cwd.child('packages/RT128156/Needed.pm6');
for 1..2 -> $i {
# Alternates putting a '#' at the end of a file
my $new-content = $trigger-file.IO.slurp.subst(/$/,"#").subst(/"##"$/,"");
$trigger-file.IO.spurt($new-content);
my $output = run $*EXECUTABLE,:out,'-I','t/spec/packages','-e','
$trigger-file.spurt($new-content);
my $output = run :cwd($run-cwd), $*EXECUTABLE,:out,'-I','packages','-e','
need RT128156::Top1;
need RT128156::Top2;
.say for MY::.keys.grep(/Needed|Top/).sort;
Expand All @@ -250,12 +265,12 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
}
{
run $*EXECUTABLE,'-I','t/spec/packages','-e','need RT128156::Top1;';
my $trigger-file = 't/spec/packages/RT128156/Needed.pm6'.IO;
run :cwd($run-cwd), $*EXECUTABLE,'-I','packages','-e','need RT128156::Top1;';
my $trigger-file = $run-cwd.child('packages/RT128156/Needed.pm6');
for 1..2 -> $i {
my $old-content = $trigger-file.slurp;
$trigger-file.spurt('class Needed { method version() { ' ~ $i ~ ' } }');
my $output = run $*EXECUTABLE,:out,'-I','t/spec/packages','-e','
my $output = run :cwd($run-cwd), $*EXECUTABLE,:out,'-I','packages','-e','
need RT128156::Top1;
print Top1.version-of-needed;
';
Expand All @@ -270,7 +285,8 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
#?rakudo.jvm todo "Invalid typename 'RT112626::Class1' in parameter declaration"
for ^2 {
is_run ｢use RT112626::Conflict; say 'pass'｣, {:out("pass\n"), :err('')},
:compiler-args['-I', 't/spec/packages'],
:compiler-args['-I', 'packages'],
:proc-args{:cwd($run-cwd)},
"roles in precompiled modules recognize type names (run $_)";
}
}
Expand All @@ -279,20 +295,22 @@ is-deeply @keys2, [<C F K P>], 'Twisty maze of dependencies, all different';
subtest 'precompiled module constants get updated on change' => {
plan 2;
constant $module = 't/spec/packages/RT129266/Foo.pm6'.IO;
constant $module = $run-cwd.child('packages/RT129266/Foo.pm6');
constant $module-content = $module.slurp;
LEAVE $module.spurt: $module-content;
is_run ｢use RT129266::Bar; say var() eq '«VALUE»' ?? 'pass' !! 'fail'｣,
:compiler-args['-I', 't/spec/packages'],
:compiler-args['-I', 'packages'],
{:out("pass\n"), :err('')},
:proc-args{:cwd($run-cwd)},
"original content has correct value";
$module.spurt: $module-content.subst: '«VALUE»', '«NEW»';
is_run ｢use RT129266::Bar; say var() eq '«NEW»' ?? 'pass' !! 'fail'｣,
:compiler-args['-I', 't/spec/packages'],
:compiler-args['-I', 'packages'],
{:out("pass\n"), :err('')},
:proc-args{:cwd($run-cwd)},
"modified content has updated";
}
Expand All @@ -303,10 +321,9 @@ with make-temp-dir() -> $dir {
｣;
for ^2 { # do two runs: 1 x without pre-existing precomp + 1 x with
is_run 'use lib \qq[$dir.absolute().perl()]; use Simple131924; '
~ 'print buggy-str() eq “: \n\r\n\r”',
{:out<True>, :err(''), :0status},
'no funny business with precompiled string strands (\qq[$_])';
is_run 'use lib \qq[$dir.absolute().perl()]; use Simple131924; print buggy-str() eq “: \n\r\n\r”',
{:out<True>, :err(''), :0status},
'no funny business with precompiled string strands (\qq[$_])';
}
}
4 changes: 2 additions & 2 deletions packages/Test/Util.pm
View file
Expand Up @@ -125,7 +125,7 @@ our sub run( Str $code, Str $input = '', *%o) {
return %got<out>;
}

sub get_out( Str $code, Str $input?, :@args, :@compiler-args) is export {
sub get_out( Str $code, Str $input?, :@args, :@compiler-args, :%proc-args) is export {
my $fnbase = 'getout';
$fnbase ~= '-' ~ $*PID if defined $*PID;
$fnbase ~= '-' ~ 1_000_000.rand.Int;
Expand Down Expand Up @@ -157,7 +157,7 @@ sub get_out( Str $code, Str $input?, :@args, :@compiler-args) is export {
$cmd ~= $fnbase ~ '.code' if $code.defined;
$cmd ~= " @actual_args.join(' ') < $fnbase.in > $fnbase.out 2> $fnbase.err";
# diag("Command line: $cmd");
%out<status> = +shell( $cmd );
%out<status> = +shell( $cmd, |%proc-args );
%out<out> = slurp "$fnbase.out";
%out<err> = slurp "$fnbase.err";

Expand Down

0 comments on commit 1b0a473

Please sign in to comment.