1 package VPIT::TestHelpers;
11 while (my ($name, $code) = each %$subs) {
13 *{$pkg.'::'.$name} = $code;
19 my %default_exports = (
20 load_or_skip => \&load_or_skip,
21 load_or_skip_all => \&load_or_skip_all,
22 run_perl => \&run_perl,
23 skip_all => \&skip_all,
27 threads => \&init_threads,
28 usleep => \&init_usleep,
35 my %exports = %default_exports;
37 for (my $i = 0; $i <= $#opts; ++$i) {
38 my $feature = $opts[$i];
39 next unless defined $feature;
42 if ($i < $#opts and defined $opts[$i+1] and ref $opts[$i+1] eq 'ARRAY') {
49 my $handler = $features{$feature};
50 die "Unknown feature '$feature'" unless defined $handler;
52 my %syms = $handler->(@$args);
54 $exports{$_} = $syms{$_} for sort keys %syms;
57 export_to_pkg \%exports => scalar caller;
64 if ($INC{'Test/Leaner.pm'}) {
65 $stash = \%Test::Leaner::;
68 $stash = \%Test::More::;
71 my $glob = $stash->{$sub};
72 return $glob ? *$glob{CODE} : undef;
75 sub skip { $test_sub->('skip')->(@_) }
77 sub skip_all { $test_sub->('plan')->(skip_all => $_[0]) }
80 my $diag = $test_sub->('diag');
88 my ($pkg, $ver, $imports) = @_;
90 my $spec = $ver && $ver !~ /^[0._]*$/ ? "$pkg $ver" : $pkg;
94 if (eval "use $spec (); 1") {
95 $ver = do { no strict 'refs'; ${"${pkg}::VERSION"} };
96 $ver = 'undef' unless defined $ver;
99 my @imports = @$imports;
100 my $caller = (caller 1)[0];
102 my $res = eval <<"IMPORTER";
105 BEGIN { \$pkg->import(\@imports) }
108 $err = "Could not import '@imports' from $pkg $ver: $@" unless $res;
111 (my $file = "$pkg.pm") =~ s{::}{/}g;
113 $err = "Could not load $spec";
117 return wantarray ? (0, $err) : 0;
119 diag "Using $pkg $ver";
125 my ($pkg, $ver, $imports, $tests) = @_;
127 die 'You must specify how many tests to skip' unless defined $tests;
129 my ($loaded, $err) = load($pkg, $ver, $imports);
130 skip $err => $tests unless $loaded;
135 sub load_or_skip_all {
136 my ($pkg, $ver, $imports) = @_;
138 my ($loaded, $err) = load($pkg, $ver, $imports);
139 skip_all $err unless $loaded;
148 die 'Double quotes in evaluated code are not portable';
151 my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
152 my $ld_name = $Config::Config{ldlibpthname};
153 my $ldlibpth = $ENV{$ld_name};
156 $ENV{$ld_name} = $ldlibpth if defined $ldlibpth;
157 $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
158 $ENV{PATH} = $PATH if $^O eq 'cygwin' and defined $PATH;
161 unless (-e $perl and -x $perl) {
162 $perl = $Config::Config{perlpath};
163 unless (-e $perl and -x $perl) {
168 system { $perl } $perl, '-T', map("-I$_", @INC), '-e', $code;
172 my ($pkg, $threadsafe, $force_var) = @_;
174 skip_all 'This perl wasn\'t built to support threads'
175 unless $Config::Config{useithreads};
177 $pkg = 'package' unless defined $pkg;
178 skip_all "This $pkg isn't thread safe" if defined $threadsafe and !$threadsafe;
180 $force_var = 'PERL_FORCE_TEST_THREADS' unless defined $force_var;
181 my $force = $ENV{$force_var} ? 1 : !1;
182 skip_all 'perl 5.13.4 required to test thread safety'
183 unless $force or "$]" >= 5.013_004;
185 if (($INC{'Test/More.pm'} || $INC{'Test/Leaner.pm'}) && !$INC{'threads.pm'}) {
186 die 'Test::More/Test::Leaner was loaded too soon';
189 load_or_skip_all 'threads', $force ? '0' : '1.67', [ ];
190 load_or_skip_all 'threads::shared', $force ? '0' : '1.14', [ ];
192 require Test::Leaner;
194 diag "Threads testing forced by \$ENV{$force_var}" if $force;
196 return spawn => \&spawn;
202 if (do { local $@; eval { require Time::HiRes; 1 } }) {
203 defined and diag "Using usleep() from Time::HiRes $_"
204 for $Time::HiRes::VERSION;
205 $usleep = \&Time::HiRes::usleep;
207 diag 'Using fallback usleep()';
209 my $s = int($_[0] / 2.5e5);
214 return usleep => $usleep;
221 local $SIG{__WARN__} = sub { push @diag, "Thread creation warning: @_" };
224 push @diag, "Thread creation error: $@" if $@;
226 return $thread ? $thread : ();
229 package VPIT::TestHelpers::Guard;
232 my ($class, $code) = @_;
234 bless { code => $code }, $class;
237 sub DESTROY { $_[0]->{code}->() }