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