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