The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;

use Cwd qw(abs_path);
use Test::More; 
use File::Find;
use FindBin qw($Bin);
use lib "$Bin/../lib";

eval "use mro 'c3'";

plan(skip_all => 'mro 1.02 or later required for testing c3 class hierarchy')
  if($@ || $mro::VERSION < 1.02); 

plan(tests => 70);

my $dir = abs_path("$Bin/../lib");

find(sub 
{
  return  unless(/\.pm$/);
  my $path = $File::Find::name;
  my $package = $path;

  for($package)
  {
    s{^$dir/}{}o;
    s{\.pm$}{};
    s{/}{::}g;
  }

  my $subclass = "My::$package";

  my $pm_file = "$Bin/mro-test.pm";
  open(my $fh, '>', $pm_file) or die "Could not write '$pm_file' - $!";

  print $fh <<"EOF";
package $subclass;

use mro 'c3';

use base '$package';

sub init
{
  my(\$self) = shift;
  \$self->next::method(\@_);
}

1;
EOF

  close($fh) or die "Could not write '$pm_file' - $!";

  my $pl_file = "$Bin/mro-test.pl";
  open($fh, '>', $pl_file) or die "Could not write '$pl_file' - $!";

  print $fh <<"EOF";
use lib qq($Bin);

require qq($pl_file);

eval
{
  if($subclass->can('name'))
  {
    $subclass->new(name => 'abc');
  }
  else
  {
    $subclass->new;
  }
};

exit(\$@ ? 1 : 0);
EOF

  close($fh) or die "Could not write '$pm_file' - $!";

  system($^X, $pl_file);

  ok(($! == -1 || ($? >> 8) != 0), $package);

  foreach my $file ($pl_file, $pm_file)
  {
    unlink($file) or die "Could not unlink($file) - $!";
  }
},
$dir);