|
 |
b8876f |
From f6203e997f3012b8aab4cd35fe49f58e4d71fb8c Mon Sep 17 00:00:00 2001
|
|
|
b8876f |
From: Karl Williamson <khw@cpan.org>
|
|
|
b8876f |
Date: Sun, 10 Jul 2016 22:06:12 -0600
|
|
|
b8876f |
Subject: [PATCH] t/test.pl: Add fresh_perl() function
|
|
|
b8876f |
MIME-Version: 1.0
|
|
|
b8876f |
Content-Type: text/plain; charset=UTF-8
|
|
|
b8876f |
Content-Transfer-Encoding: 8bit
|
|
|
b8876f |
|
|
|
b8876f |
This will be useful for cases where the results don't readily fall into
|
|
|
b8876f |
fresh_perl_is and fresh_perl_like, such as when a bunch of massaging of
|
|
|
b8876f |
the results is needed before it is convenient to test them.
|
|
|
b8876f |
fresh_perl_like() could be used, but in the case of failure there could
|
|
|
b8876f |
be lines and lines of noise output.
|
|
|
b8876f |
|
|
|
b8876f |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
b8876f |
---
|
|
|
b8876f |
t/test.pl | 25 +++++++++++++++++++++----
|
|
|
b8876f |
1 file changed, 21 insertions(+), 4 deletions(-)
|
|
|
b8876f |
|
|
|
b8876f |
diff --git a/t/test.pl b/t/test.pl
|
|
|
b8876f |
index 41b77f4..20d08e9 100644
|
|
|
b8876f |
--- a/t/test.pl
|
|
|
b8876f |
+++ b/t/test.pl
|
|
|
b8876f |
@@ -953,11 +953,16 @@ sub register_tempfile {
|
|
|
b8876f |
return $count;
|
|
|
b8876f |
}
|
|
|
b8876f |
|
|
|
b8876f |
-# This is the temporary file for _fresh_perl
|
|
|
b8876f |
+# This is the temporary file for fresh_perl
|
|
|
b8876f |
my $tmpfile = tempfile();
|
|
|
b8876f |
|
|
|
b8876f |
-sub _fresh_perl {
|
|
|
b8876f |
- my($prog, $action, $expect, $runperl_args, $name) = @_;
|
|
|
b8876f |
+sub fresh_perl {
|
|
|
b8876f |
+ my($prog, $runperl_args) = @_;
|
|
|
b8876f |
+
|
|
|
b8876f |
+ # Run 'runperl' with the complete perl program contained in '$prog', and
|
|
|
b8876f |
+ # arguments in the hash referred to by '$runperl_args'. The results are
|
|
|
b8876f |
+ # returned, with $? set to the exit code. Unless overridden, stderr is
|
|
|
b8876f |
+ # redirected to stdout.
|
|
|
b8876f |
|
|
|
b8876f |
# Given the choice of the mis-parsable {}
|
|
|
b8876f |
# (we want an anon hash, but a borked lexer might think that it's a block)
|
|
|
b8876f |
@@ -975,7 +980,8 @@ sub _fresh_perl {
|
|
|
b8876f |
close TEST or die "Cannot close $tmpfile: $!";
|
|
|
b8876f |
|
|
|
b8876f |
my $results = runperl(%$runperl_args);
|
|
|
b8876f |
- my $status = $?;
|
|
|
b8876f |
+ my $status = $?; # Not necessary to save this, but it makes it clear to
|
|
|
b8876f |
+ # future maintainers.
|
|
|
b8876f |
|
|
|
b8876f |
# Clean up the results into something a bit more predictable.
|
|
|
b8876f |
$results =~ s/\n+$//;
|
|
|
b8876f |
@@ -994,6 +1000,17 @@ sub _fresh_perl {
|
|
|
b8876f |
$results =~ s/\n\n/\n/g;
|
|
|
b8876f |
}
|
|
|
b8876f |
|
|
|
b8876f |
+ $? = $status;
|
|
|
b8876f |
+ return $results;
|
|
|
b8876f |
+}
|
|
|
b8876f |
+
|
|
|
b8876f |
+
|
|
|
b8876f |
+sub _fresh_perl {
|
|
|
b8876f |
+ my($prog, $action, $expect, $runperl_args, $name) = @_;
|
|
|
b8876f |
+
|
|
|
b8876f |
+ my $results = fresh_perl($prog, $runperl_args);
|
|
|
b8876f |
+ my $status = $?;
|
|
|
b8876f |
+
|
|
|
b8876f |
# Use the first line of the program as a name if none was given
|
|
|
b8876f |
unless( $name ) {
|
|
|
b8876f |
($first_line, $name) = $prog =~ /^((.{1,50}).*)/;
|
|
|
b8876f |
--
|
|
|
b8876f |
2.7.4
|
|
|
b8876f |
|