From f6203e997f3012b8aab4cd35fe49f58e4d71fb8c Mon Sep 17 00:00:00 2001 From: Karl Williamson 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ř --- 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