1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
| | #!perl -w
# Copyright (C) mwrap hackers <mwrap-perl@80x24.org>
# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
package MwrapTest;
use v5.12;
use parent qw(Exporter);
use Test::More;
use File::Temp 0.19 (); # 0.19 for ->newdir
our $mwrap_src;
$mwrap_src = slurp('blib/script/mwrap-perl') if -e 'script/mwrap-perl';
our $mwrap_tmp = File::Temp->newdir('mwrap-XXXX', TMPDIR => 1);
our $mwrap_out = "$mwrap_tmp/out";
our $mwrap_err = "$mwrap_tmp/err";
our @EXPORT = qw(mwrap_run slurp $mwrap_err $mwrap_out $mwrap_src $mwrap_tmp);
sub slurp {
open my $fh, '<', $_[0] or die "open($_[0]): $!";
local $/;
<$fh>;
}
sub mwrap_run {
my ($msg, $env, @args) = @_;
my $pid = fork;
if ($pid == 0) {
while (my ($k, $v) = each %$env) {
$ENV{$k} = $v;
}
open STDERR, '>', $mwrap_err or die "open: $!";
open STDOUT, '>', $mwrap_out or die "open: $!";
if (defined $mwrap_src) {
unless (grep(/\A-.+\bMwrap\b/, @args)) {
unshift @args, '-MDevel::Mwrap';
}
@ARGV = ($^X, @args);
eval $mwrap_src;
} else {
my $ruby = $ENV{RUBY} // 'ruby';
exec $ruby, '-Ilib', 'bin/mwrap', $ruby, @args;
}
die "fail: $! ($@)";
}
if (defined(wantarray)) {
return $pid if !wantarray;
die "BUG: list return value not supported\n";
}
waitpid($pid, 0);
is($?, 0, $msg);
diag "err: ".slurp($mwrap_err) if $?;
}
package main;
MwrapTest->import;
Test::More->import;
1;
|