In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f6203e997f3012b8aab4cd35fe49f58e4d71fb8c?hp=d1bd48a0bf64e4969a36b6ebe7f93c0ceea5529b>
- Log ----------------------------------------------------------------- commit f6203e997f3012b8aab4cd35fe49f58e4d71fb8c Author: Karl Williamson <[email protected]> Date: Sun Jul 10 22:06:12 2016 -0600 t/test.pl: Add fresh_perl() function 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. M t/test.pl commit f0858b7d39dbdebf568eb680bf59acd0aa591abe Author: Karl Williamson <[email protected]> Date: Tue Jul 5 19:23:59 2016 -0600 SSize_t instead of IV This is a sized STRLEN equivalent, so IV is less correct M embed.fnc M proto.h M regcomp.c commit 243a3b9c6db780de9b2f8ab4bf33f0417a0b5e29 Author: Karl Williamson <[email protected]> Date: Tue Jul 5 19:17:18 2016 -0600 regcomp.h: Use #define mnemonic, not hard-coded number M regcomp.h ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- proto.h | 2 +- regcomp.c | 2 +- regcomp.h | 2 +- t/test.pl | 25 +++++++++++++++++++++---- 5 files changed, 25 insertions(+), 8 deletions(-) diff --git a/embed.fnc b/embed.fnc index 9b3a28b..9458575 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1598,7 +1598,7 @@ EiMRn |UV* |invlist_array |NN SV* const invlist EiMRn |bool* |get_invlist_offset_addr|NN SV* invlist EiMRn |UV |_invlist_len |NN SV* const invlist EMiRn |bool |_invlist_contains_cp|NN SV* const invlist|const UV cp -EXpMRn |IV |_invlist_search |NN SV* const invlist|const UV cp +EXpMRn |SSize_t|_invlist_search |NN SV* const invlist|const UV cp EXMpR |SV* |_get_swash_invlist|NN SV* const swash EXMpR |HV* |_swash_inversion_hash |NN SV* const swash #endif diff --git a/proto.h b/proto.h index 2d12387..b03d2ab 100644 --- a/proto.h +++ b/proto.h @@ -5117,7 +5117,7 @@ PERL_STATIC_INLINE UV S__invlist_len(SV* const invlist) #define PERL_ARGS_ASSERT__INVLIST_LEN \ assert(invlist) -PERL_CALLCONV IV Perl__invlist_search(SV* const invlist, const UV cp) +PERL_CALLCONV SSize_t Perl__invlist_search(SV* const invlist, const UV cp) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT__INVLIST_SEARCH \ assert(invlist) diff --git a/regcomp.c b/regcomp.c index 4592f49..91e1c9a 100644 --- a/regcomp.c +++ b/regcomp.c @@ -8730,7 +8730,7 @@ S__append_range_to_invlist(pTHX_ SV* const invlist, #ifndef PERL_IN_XSUB_RE -IV +SSize_t Perl__invlist_search(SV* const invlist, const UV cp) { /* Searches the inversion list for the entry that contains the input code diff --git a/regcomp.h b/regcomp.h index a8842a1..79c2853 100644 --- a/regcomp.h +++ b/regcomp.h @@ -1054,7 +1054,7 @@ re.pm, especially to the documentation. /* get_sv() can return NULL during global destruction. */ #define GET_RE_DEBUG_FLAGS DEBUG_r({ \ SV * re_debug_flags_sv = NULL; \ - re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, 1) : NULL; \ + re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, GV_ADD) : NULL; \ if (re_debug_flags_sv) { \ if (!SvIOK(re_debug_flags_sv)) \ sv_setuv(re_debug_flags_sv, RE_DEBUG_COMPILE_DUMP | RE_DEBUG_EXECUTE_MASK ); \ 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}).*)/; -- Perl5 Master Repository
