Don't include tests on native traits
[gitmo/Mouse.git] / author / import-moose-test.pl
1 #!/usr/bin/perl -w
2 use 5.10.0;
3 use strict;
4 use warnings FATAL => 'all';
5 use File::Path qw(mkpath);
6 use File::Find;
7 use autodie;
8
9 my($moose_dir, $result) = @ARGV;
10 unless(defined $moose_dir and -d "$moose_dir/t") {
11     die "Usage: $0 Moose-dir [result-dir]\n";
12 }
13 $result //= 'Moose-t';
14
15 my @tests;
16 sub wanted {
17     return if /native_traits/;
18     (my $mouse_test         = $_) =~ s{\A $moose_dir/t }{$result}xmso;
19     (my $mouse_failing_test = $_) =~ s{\A $moose_dir/t }{$result-failing}xmso;
20     if( -d $_ ) {
21         mkpath [$mouse_test, $mouse_failing_test];
22         return;
23     }
24     copy_as_mouse($_ => $mouse_test);
25     push @tests, [$mouse_test, $mouse_failing_test]
26         if $mouse_test =~/\.t\z/xms;
27     return;
28 }
29
30 find { wanted => \&wanted, no_chdir => 1 }, "$moose_dir/t/";
31
32 say "Testing ...";
33
34 $ENV{PERL5LIB} = join ':', "$result/lib", @INC;
35
36 my $ok = 0;
37 foreach my $t(sort { $b cmp $a } @tests) {
38     my($t, $fail) = @{$t};
39     if(system(qq{$^X $t 2>&1 >/dev/null}) == 0) {
40         say "$t ... ok";
41         $ok++;
42     }
43     else {
44         # make it TODO and retyr it
45         open my $in,'<', $t;
46         open my $out, '>', "/tmp/retry.t.$$";
47         while(<$in>) {
48             print $out $_;
49             /use Test::More/
50                 && say $out '$TODO = q{Mouse is not yet completed};';
51         }
52         close $in;
53         close $out;
54
55         rename "/tmp/retry.t.$$", $t;
56
57         if(system(qq{$^X $t 2>&1 >/dev/null}) == 0) {
58             say "$t ... ok (TODO)";
59             $ok++;
60         }
61         else {
62             say "$t ... not ok";
63             rename $t, $fail;
64         }
65     }
66 }
67 say sprintf "%d %% (%d/%d) succeed.", ($ok/@tests)*100, $ok, scalar @tests;
68
69 sub copy_as_mouse {
70     my($moose, $mouse) = @_;
71     open my $in, '<',  $moose;
72     open my $out, '>', $mouse;
73  
74     while(<$in>) {
75         if($. == 2) {
76             say $out "# This is automatically generated by $0.";
77             say $out "# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!";
78             say $out 'use t::lib::MooseCompat;';
79         }
80         s/\b Class::MOP::([a-z_]+) \b/Mouse::Util::$1/xmsg;
81         s/\b Class::MOP \b /Mouse::Meta/xmsg;
82         s/\b Moose \b/Mouse/xmsg;
83
84         # make classes simple
85         s{\b(Mouse::Meta::TypeConstraint)::\w+    }{$1}xmsg;
86         s{\b(Mouse::Meta::Role::Application)::\w+ }{$1}xmsg;
87         s{\b(Mouse::Meta::Method)::\w+            }{$1}xmsg;
88
89         print $out $_;
90     }
91     close $in;
92     close $out;
93 }