]> git.vpit.fr Git - perl/modules/Variable-Temp.git/blob - t/lib/VPIT/TestHelpers.pm
This is 0.01
[perl/modules/Variable-Temp.git] / t / lib / VPIT / TestHelpers.pm
1 package VPIT::TestHelpers;
2
3 use strict;
4 use warnings;
5
6 use Config ();
7
8 my %exports = (
9  load_or_skip     => \&load_or_skip,
10  load_or_skip_all => \&load_or_skip_all,
11  run_perl         => \&run_perl,
12  skip_all         => \&skip_all,
13 );
14
15 sub import {
16  my $pkg = caller;
17
18  while (my ($name, $code) = each %exports) {
19   no strict 'refs';
20   *{$pkg.'::'.$name} = $code;
21  }
22 }
23
24 my $test_sub = sub {
25  my $sub = shift;
26
27  my $stash;
28  if ($INC{'Test/Leaner.pm'}) {
29   $stash = \%Test::Leaner::;
30  } else {
31   require Test::More;
32   $stash = \%Test::More::;
33  }
34
35  my $glob = $stash->{$sub};
36  return $glob ? *$glob{CODE} : undef;
37 };
38
39 sub skip { $test_sub->('skip')->(@_) }
40
41 sub skip_all { $test_sub->('plan')->(skip_all => $_[0]) }
42
43 sub diag {
44  my $diag = $test_sub->('diag');
45  $diag->($_) for @_;
46 }
47
48 our $TODO;
49 local $TODO;
50
51 sub load {
52  my ($pkg, $ver, $imports) = @_;
53
54  my $spec = $ver && $ver !~ /^[0._]*$/ ? "$pkg $ver" : $pkg;
55  my $err;
56
57  local $@;
58  if (eval "use $spec (); 1") {
59   $ver = do { no strict 'refs'; ${"${pkg}::VERSION"} };
60   $ver = 'undef' unless defined $ver;
61
62   if ($imports) {
63    my @imports = @$imports;
64    my $caller  = (caller 1)[0];
65    local $@;
66    my $res = eval <<"IMPORTER";
67 package
68         $caller;
69 BEGIN { \$pkg->import(\@imports) }
70 1;
71 IMPORTER
72    $err = "Could not import '@imports' from $pkg $ver: $@" unless $res;
73   }
74  } else {
75   (my $file = "$pkg.pm") =~ s{::}{/}g;
76   delete $INC{$file};
77   $err = "Could not load $spec";
78  }
79
80  if ($err) {
81   return wantarray ? (0, $err) : 0;
82  } else {
83   diag "Using $pkg $ver";
84   return 1;
85  }
86 }
87
88 sub load_or_skip {
89  my ($pkg, $ver, $imports, $tests) = @_;
90
91  die 'You must specify how many tests to skip' unless defined $tests;
92
93  my ($loaded, $err) = load($pkg, $ver, $imports);
94  skip $err => $tests unless $loaded;
95
96  return $loaded;
97 }
98
99 sub load_or_skip_all {
100  my ($pkg, $ver, $imports) = @_;
101
102  my ($loaded, $err) = load($pkg, $ver, $imports);
103  skip_all $err unless $loaded;
104
105  return $loaded;
106 }
107
108 sub run_perl {
109  my $code = shift;
110
111  my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
112  my $ld_name  = $Config::Config{ldlibpthname};
113  my $ldlibpth = $ENV{$ld_name};
114
115  local %ENV;
116  $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
117  $ENV{PATH}       = $PATH       if $^O eq 'cygwin'  and defined $PATH;
118  $ENV{$ld_name}   = $ldlibpth   if $^O eq 'android' and defined $ldlibpth;
119
120  system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
121 }
122
123 package VPIT::TestHelpers::Guard;
124
125 sub new {
126  my ($class, $code) = @_;
127
128  bless { code => $code }, $class;
129 }
130
131 sub DESTROY { $_[0]->{code}->() }
132
133 1;