e624c0c5e66184278c66f4f176d3962e6b65775f
[p5sagit/namespace-clean.git] / t / 10-pure-perl.t
1 use strict;
2 use warnings;
3 use Test::More;
4
5 BEGIN {
6   plan skip_all => "PP tests already executed"
7     if $ENV{NAMESPACE_CLEAN_USE_PP};
8
9   plan skip_all => "B::Hooks::EndOfScope ($INC{'B/Hooks/EndOfScope.pm'}) loaded before the test even started >.<"
10     if $INC{'B/Hooks/EndOfScope.pm'};
11
12   plan skip_all => "Package::Stash ($INC{'Package/Stash.pm'}) loaded before the test even started >.<"
13     if $INC{'Package/Stash.pm'};
14
15   eval { require Variable::Magic }
16     or plan skip_all => "PP tests already executed";
17
18   $ENV{B_HOOKS_ENDOFSCOPE_IMPLEMENTATION} = 'PP';
19   $ENV{PACKAGE_STASH_IMPLEMENTATION} = 'PP';
20 }
21
22 use B::Hooks::EndOfScope 0.12;
23 use Package::Stash;
24
25 ok(
26   ($INC{'B/Hooks/EndOfScope/PP.pm'} && ! $INC{'B/Hooks/EndOfScope/XS.pm'}),
27   'PP BHEOS loaded properly'
28 ) || diag join "\n",
29   map { sprintf '%s => %s', $_, $INC{"B/Hooks/$_"} || 'undef' }
30   qw|EndOfScope.pm EndOfScope/XS.pm EndOfScope/PP.pm|
31 ;
32
33 ok(
34   ($INC{'Package/Stash/PP.pm'} && ! $INC{'Package/Stash/XS.pm'}),
35   'PP Package::Stash loaded properly'
36 ) || diag join "\n",
37   map { sprintf '%s => %s', $_, $INC{"Package/$_"} || 'undef' }
38   qw|Stash.pm Stash/XS.pm Stash/PP.pm|
39 ;
40
41 use Config;
42 use FindBin qw($Bin);
43 use IPC::Open2 qw(open2);
44 use File::Glob 'bsd_glob';
45
46 # for the $^X-es
47 $ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
48
49
50 # rerun the tests under the assumption of pure-perl
51 my $this_file = quotemeta(__FILE__);
52
53 for my $fn (bsd_glob("$Bin/*.t")) {
54   next if $fn =~ /${this_file}$/;
55
56   my @cmd = ($^X, $fn);
57
58   # this is cheating, and may even hang here and there (testing on windows passed fine)
59   # if it does - will have to fix it somehow (really *REALLY* don't want to pull
60   # in IPC::Cmd just for a fucking test)
61   # the alternative would be to have an ENV check in each test to force a subtest
62   open2(my $out, my $in, @cmd);
63   while (my $ln = <$out>) {
64     print "   $ln";
65   }
66
67   wait;
68   ok (! $?, "Exit $? from: @cmd");
69 }
70
71 done_testing;