use warnings;
use strict;
use File::Spec ();
use File::Temp ();
use File::Path ();
use Fcntl ();
use Test::More;
use t::_Util;

############################################################################
###
### Prepare a bunch of handles to work with
###

my $tmp_suff = 'X' x 8;

my $io = {
  tempdir => File::Temp::tempdir("stdio_tester_$tmp_suff",
    CLEANUP => 0,
    TMPDIR => 1,
  ) || die 'Unable to create tempdir ' . ($@ || $!),
};

my $init_pid = $$;
END {
  File::Path::rmtree([ $io->{tempdir} ])
    if $io->{tempdir} and $$ == $init_pid;
}
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { exit 255 };

# crucial for the tester to actually run
local $ENV{PERL5OPT} = '';


for (
  [ ro => Fcntl::O_RDONLY() ],
  [ wo => Fcntl::O_WRONLY() ],
  [ rw => Fcntl::O_RDWR() ],
) {
  my ($type, $mode) = @$_;

  $mode |= Fcntl::O_CREAT();

  sysopen(
    $io->{"file_$type"},
    File::Temp::mktemp( "$io->{tempdir}/${type}_$tmp_suff" ),
    $mode,
  ) or die "Opening $type tempfile failed; $!";

  sysopen(
    $io->{"null_$type"},
    File::Spec->devnull,
    $mode,
  ) or die "Opening $type handle to devnull failed; $!";
}

pipe( $io->{pipe_ro}, $io->{pipe_wo} )
  or die "Unable to open testpipe: $!";

if ( my ($some_tty) = map
  { ( -t (\%{main::})->{$_} ) ? (\%{main::})->{$_} : () }
  STD_NAMES
) {
  # check for weird-ass non-rw TTY's
  # ( e.g. prove ... < /dev/stdin )
  # this will fail further down in case of a mismatch
  if (my $mode = fcntl(
    $some_tty,
    Fcntl::F_GETFL(),
    (my $getfl_throwaway_buf = '')
  )) {
    ( $mode & Fcntl::O_ACCMODE() ) == Fcntl::O_RDWR()
      and
    open( $io->{tty}, '+<&' . $some_tty->fileno )
  }
}

$io->{tty} ||= eval {
  require IO::Pty;
  # the slave will stop satisfying -t if we lose the master
  ($::_master_pty_global_ = IO::Pty->new)->slave;
};


############################################################################
###
### Handles prepared, set plans
###

my $io_variants;
my @types = (
  qw( null null_rw file file_rw pipe closed ),
  ( $io->{tty} ? 'tty' : () ),
);
for my $in (@types) {
  for my $out (@types) {
    for my $err (@types) {
      push @$io_variants, [ $in, $out, $err ];
    }
  }
}

plan tests =>
  @$io_variants
    +
  ( $io->{tty} ? 0 : 1 )
    +
  9
;

SKIP: {
  skip "Unable to acquire TTY for testing - STDIO is all files/pipes, and IO::Pty not found", 1
    unless $io->{tty};
}

############################################################################
###
### Round of "must pass" tests
###

for my $io_variant ( @$io_variants ) {

  my $io_handles_to_use;
  for my $fd (0,1,2) {
    my $io_key = $io_variant->[$fd];

    push @$io_handles_to_use, (
      ( $io_key eq 'closed' )                ? undef
    : ( $io_key =~ / (?: ^tty | _rw ) $ /x ) ? [ $io->{$io_key},         '+<']
    : ( $fd == 0 )                           ? [ $io->{$io_key . '_ro'}, '<' ]
    :                                          [ $io->{$io_key . '_wo'}, '>' ]
    );
  }

  my $title = join '/', @$io_variant;

  if( my $errors = t::_Util::stdio_state_errors(
    command => [ $^X, '%%' ],
    set_stdio => $io_handles_to_use,
    expected => [ map { ( $_ =~ /([a-z]+)/ ) } @$io_variant ],
  )) {
    fail join "\n", "Unexpected errors during testing of $title:", map { "    $_" } @$errors
  }
  else {
    pass "No unexpected errors during testing of $title";
  }
}

############################################################################
###
### Check that failures are in fact properly detected (don't check error content)
###
my %fail_tests = (
  (map
    {
      $_->[0] => {
        set_stdio => [
          $_->[1],
          undef,
          undef,
        ],
        expected => [qw( null closed closed )],
      },
    }
    (
      [ 'wrong IN dup' => [ $io->{null_ro}, '>' ] ],
      [ 'wrong IN handle' => [ $io->{null_wo}, '<' ] ],
      [ 'wrong IN handle and matching dup' => [ $io->{null_wo}, '>' ] ],
    )
  ),


  (map
    {
      $_->[0] => {
        set_stdio => [
          undef,
          $_->[1],
          undef,
        ],
        expected => [qw( closed null closed )],
      },
    }
    (
      [ 'wrong OUT dup' => [ $io->{null_wo}, '<' ] ],
      [ 'wrong OUT handle' => [ $io->{null_ro}, '>' ] ],
      [ 'wrong OUT handle and matching dup' => [ $io->{null_ro}, '<' ] ],
    )
  ),

  (map
    {
      $_->[0] => {
        set_stdio => [
          undef,
          undef,
          $_->[1],
        ],
        expected => [qw( closed closed null )],
      },
    }
    (
      [ 'wrong ERR dup' => [ $io->{null_wo}, '<' ] ],
      [ 'wrong ERR handle' => [ $io->{null_ro}, '>' ] ],
      [ 'wrong ERR handle and matching dup' => [ $io->{null_ro}, '<' ] ],
    )
  ),

);

while ( my ($name, $args) = each %fail_tests ) {
  ok( do {
    local $SIG{__DIE__} = sub {};
    t::_Util::stdio_state_errors( %$args, command => [ $^X, '%%' ] );
  }, "Errors returned for testing $name" );
}
