about summary refs log tree commit homepage
diff options
context:
space:
mode:
authorEric Wong <e@80x24.org>2022-12-10 01:55:17 +0000
committerEric Wong <mwrap-perl@80x24.org>2022-12-10 02:09:27 +0000
commita71108e723b78fb545c786d9220e087c3b29f18c (patch)
tree113facb092842c0c6c635f8b836a3a20a92a0b3c
parentdd7f0f6218561d132f9d7450d9b27bdce7096460 (diff)
downloadmwrap-a71108e723b78fb545c786d9220e087c3b29f18c.tar.gz
This will make it easier to split out tests to separate files in
the future.
-rw-r--r--MANIFEST1
-rw-r--r--t/mwrap.t47
-rw-r--r--t/test_common.perl48
3 files changed, 56 insertions, 40 deletions
diff --git a/MANIFEST b/MANIFEST
index eb8098e..c732c56 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -17,4 +17,5 @@ ppport.h
 script/mwrap-perl
 t/mwrap.t
 t/source_location.perl
+t/test_common.perl
 typemap
diff --git a/t/mwrap.t b/t/mwrap.t
index 0bb3ea8..bf6ae6e 100644
--- a/t/mwrap.t
+++ b/t/mwrap.t
@@ -2,15 +2,9 @@
 # Copyright (C) mwrap hackers <mwrap-perl@80x24.org>
 # License: GPL-2.0+ <https://www.gnu.org/licenses/gpl-2.0.txt>
 use v5.12;
-use Test::More;
-use File::Temp qw(tempdir);
+BEGIN { require './t/test_common.perl' };
 use_ok 'Devel::Mwrap';
-
-my $tmpdir = tempdir('mwrap-perl-XXXX', TMPDIR => 1, CLEANUP => 1);
-my $dump = "$tmpdir/dump";
-my $out = "$tmpdir/out";
-my $err = "$tmpdir/err";
-my $src = slurp('blib/script/mwrap-perl');
+my $dump = "$mwrap_tmp/dump";
 
 {
         my $env = { MWRAP => "dump_path:$dump,dump_min:10000" };
@@ -36,9 +30,9 @@ SKIP: { # C++ program which uses malloc via "new"
         skip 'cmake missing', 2 if $?;
         skip "`cmake -h' gave no output", 2 unless $exp =~ /\S/s;
         mwrap_run('cmake (C++ new)', {}, '-e', 'system(qw(cmake -h)); exit $?');
-        my $res = slurp($out);
+        my $res = slurp($mwrap_out);
         is($res, $exp, "`cmake -h' works");
-        diag slurp($err);
+        diag slurp($mwrap_err);
 };
 
 {
@@ -47,7 +41,7 @@ my $A = Devel::Mwrap::total_bytes_allocated();
 my $f = Devel::Mwrap::total_bytes_freed();
 print("$A - $f\n");
 E1
-        my $o = slurp($out);
+        my $o = slurp($mwrap_out);
         like($o, qr/^([0-9]+) - ([0-9]+)\n/s, 'got allocated & freed bytes');
 }
 
@@ -136,7 +130,7 @@ $sl_each[0]->[0] >= $nbytes or die "$sl_each[0]->[0] < $nbytes";
 my $age_after = $sl_each[0]->[1];
 $age_after >= $age_before or die "age did not increment";
 EOF
-diag slurp($out);
+diag slurp($mwrap_out);
 
 is(Devel::Mwrap::quiet(1), 0, 'was not quiet, before');
 is(Devel::Mwrap::quiet(0), 1, 'was quiet, before');
@@ -172,31 +166,4 @@ EOM
                 'aligned_alloc + cfree function ran w/o crashing');
 };
 
-done_testing();
-
-sub slurp {
-        open my $fh, '<', $_[0] or die "open($_[0]): $!";
-        local $/;
-        <$fh>;
-}
-
-sub mwrap_run {
-        my ($msg, $env, @args) = @_;
-        unless (grep(/\A-.+\bMwrap\b/, @args)) {
-                unshift @args, '-MDevel::Mwrap';
-        }
-        my $pid = fork;
-        if ($pid == 0) {
-                while (my ($k, $v) = each %$env) {
-                        $ENV{$k} = $v;
-                }
-                open STDERR, '>', $err or die "open: $!";
-                open STDOUT, '>', $out or die "open: $!";
-                @ARGV = ($^X, @args);
-                eval $src;
-                die "fail: $! ($@)";
-        }
-        waitpid($pid, 0);
-        is($?, 0, $msg);
-        diag "err: ".slurp($err) if $?;
-}
+done_testing;
diff --git a/t/test_common.perl b/t/test_common.perl
new file mode 100644
index 0000000..94da8f4
--- /dev/null
+++ b/t/test_common.perl
@@ -0,0 +1,48 @@
+#!perl -w
+# Copyright (C) mwrap hackers <mwrap-perl@80x24.org>
+# License: GPL-2.0+ <https://www.gnu.org/licenses/gpl-2.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 = slurp('blib/script/mwrap-perl');
+our $mwrap_tmp = File::Temp->newdir('mwrap-perl-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) = @_;
+        unless (grep(/\A-.+\bMwrap\b/, @args)) {
+                unshift @args, '-MDevel::Mwrap';
+        }
+        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: $!";
+                @ARGV = ($^X, @args);
+                eval $mwrap_src;
+                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;