X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2Flib%2FVPIT%2FTestHelpers.pm;h=aeabc166c72663b1e1c7e926591e3b89d4f5de0b;hp=476ce9ba92e837164e5f775ac308ff2e205304e5;hb=ad7f92aa119dd23a7a81581adb2628ffa8102357;hpb=b05f4291bec38d550b98e45a9e6f2320403905d3 diff --git a/t/lib/VPIT/TestHelpers.pm b/t/lib/VPIT/TestHelpers.pm index 476ce9b..aeabc16 100644 --- a/t/lib/VPIT/TestHelpers.pm +++ b/t/lib/VPIT/TestHelpers.pm @@ -97,7 +97,9 @@ my $test_sub = sub { } my $glob = $stash->{$sub}; - return $glob ? *$glob{CODE} : undef; + return ref \$glob eq 'GLOB' ? *$glob{CODE} + : ref $glob eq 'CODE' ? $glob + : undef; }; sub skip { $test_sub->('skip')->(@_) } @@ -193,7 +195,15 @@ C<$p> is prefixed to the constants exported by this feature (defaults to C<''>). =item * -Dependencies : none +Dependencies : + +=over 8 + +=item - + +L + +=back =item * @@ -207,6 +217,10 @@ C =item - +C + +=item - + C (possibly prefixed by C<$p>) =back @@ -241,8 +255,14 @@ sub fresh_perl_env (&) { sub init_run_perl { my $p = sanitize_prefix(shift); + # This is only required for run_perl_file(), so it is not needed for the + # threads feature which only calls run_perl() - don't forget to update its + # requirements if this ever changes. + require File::Spec; + return ( run_perl => \&run_perl, + run_perl_file => \&run_perl_file, "${p}RUN_PERL_FAILED" => sub () { 'Could not execute perl subprocess' }, ); } @@ -260,6 +280,20 @@ sub run_perl { }; } +sub run_perl_file { + my $file = shift; + + $file = File::Spec->rel2abs($file); + unless (-e $file and -r _) { + die 'Could not run perl file'; + } + + fresh_perl_env { + my ($perl, @perl_args) = @_; + system { $perl } $perl, @perl_args, $file; + }; +} + =head2 C =over 4 @@ -600,6 +634,18 @@ C =back +=item * + +Notes : + +=over 8 + +=item - + +C<< exit => 'threads_only' >> is passed to C<< threads->import >>. + +=back + =back =cut @@ -612,6 +658,7 @@ sub init_threads { if (defined $pkg and defined $threadsafe_var) { my $threadsafe; + # run_perl() doesn't actually require anything my $stat = run_perl("require POSIX; require $pkg; exit($threadsafe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())"); if (defined $stat) { require POSIX; @@ -644,7 +691,9 @@ sub init_threads { die "$test_module was loaded too soon" if defined $test_module; } - load_or_skip_all 'threads', $force ? '0' : '1.67', [ ]; + load_or_skip_all 'threads', $force ? '0' : '1.67', [ + exit => 'threads_only', + ]; load_or_skip_all 'threads::shared', $force ? '0' : '1.14', [ ]; diag "Threads testing forced by \$ENV{$force_var}" if $force; @@ -788,11 +837,11 @@ sub DESTROY { $_[0]->{code}->() } =head1 AUTHOR -Vincent Pit, C<< >>, L. +Vincent Pit C<< >>. =head1 COPYRIGHT & LICENSE -Copyright 2012,2013,2014,2015 Vincent Pit, all rights reserved. +Copyright 2012,2013,2014,2015,2019 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.