view release on metacpan or  search on metacpan

lib/Test/Alien.pm  view on Meta::CPAN

  if(defined $alien)
  {
    my @missing = grep { ! $alien->can($_) } @methods;

    $ok = !@missing;
    push @diag, map { "  missing method $_" } @missing;

    if($ok)
    {
      push @aliens, $alien;
      if($^O eq 'MSWin32' && $alien->isa('Alien::MSYS'))
      {
        unshift @PATH, Alien::MSYS::msys_path();
      }
      else
      {
        unshift @PATH, $alien->bin_dir;
      }
    }

    if($alien->can('alien_helper'))
    {
      my($intr) = _interpolator();

      my $help = eval { $alien->alien_helper };

      if(my $error = $@)
      {
        $ok = 0;
        push @diag, "  error getting helpers: $error";
      }

      foreach my $name (keys %$help)
      {
        my $code = $help->{$name};
        $intr->replace_helper($name, $code);
      }
    }
  }
  else
  {
    $ok = 0;
    push @diag, "  undefined alien";
  }

  my $ctx = context();
  $ctx->ok($ok, $message);
  $ctx->diag($_) for @diag;
  $ctx->release;

  $ok;
}


sub synthetic
{
  my($opt) = @_;
  $opt ||= {};
  my %alien = %$opt;
  require Test::Alien::Synthetic;
  bless \%alien, 'Test::Alien::Synthetic',
}


sub run_ok
{
  my($command, $message) = @_;

  my(@command) = ref $command ? @$command : (do {
    my $command = $command; # make a copy

    # Double the backslashes so that when they are unescaped by shellwords(),
    # they become a single backslash. This should be fine on Windows since
    # backslashes are not used to escape metacharacters in cmd.exe.
    $command =~ s/\\/\\\\/g if $^O eq 'MSWin32';
    shellwords $command;
  });
  $message ||= ref $command ? "run @command" : "run $command";

  require Test::Alien::Run;
  my $run = bless {
    out    => '',
    err    => '',
    exit   => 0,
    sig    => 0,
    cmd    => [@command],
  }, 'Test::Alien::Run';

  my $ctx = context();
  my $exe = which $command[0];
  if(defined $exe)
  {
    if(ref $command)
    {
      shift @command;
      $run->{cmd} = [$exe, @command];
    }
    else
    {
      $run->{cmd} = [$command];
    }
    my @diag;
    my $ok = 1;
    my($exit, $errno);
    ($run->{out}, $run->{err}, $exit, $errno) = capture {

      if(ref $command)
      {
        system $exe, @command;
      }
      else
      {
        system $command;
      }

      ($?,$!);
    };

    if($exit == -1)
    {
      $ok = 0;
      $run->{fail} = "failed to execute: $errno";
      push @diag, "  failed to execute: $errno";
    }
    elsif($exit & 127)
    {
      $ok = 0;
      push @diag, "  killed with signal: @{[ $exit & 127 ]}";
      $run->{sig} = $exit & 127;
    }
    else
    {
      $run->{exit} = $exit >> 8;
    }

    $ctx->ok($ok, $message);
    $ok
      ? $ctx->note("  using $exe")
      : $ctx->diag("  using $exe");
    $ctx->diag(@diag) for @diag;