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

# important for the tester exec
$ENV{PERL5OPT} = '';

my $io = {
  tempdir => File::Temp::tempdir('stdio_tester_XXXXXXXX',
    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} = sub { exit 255 };

sub STD_NAMES() { qw( stdin stdout stderr ) }

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}XXXXXXXX" ),
    $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;
};

my $io_variants = [ map
  { [ split /_SEP_/,  $_ ] }
  glob join "_SEP_", (
    '{'
  . join(',', qw( pipe null null_rw file file_rw closed ), ($io->{tty} ? 'tty' : () ) )
  . '}'
  ) x 3
];

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

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

for my $io_variant ( @$io_variants ) {

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

  my $expected_pass_per_fd = [ map { ( $_ =~ /([a-z]+)/ ) } @$io_variant ];

  my $result_by_tester;

  for my $tester (qw( closed null pipe file tty )) {
    my $child = fork();

    die "Unable to fork: $!"
      if ! defined $child;

    if (!$child) {
      $SIG{__DIE__} = $SIG{__WARN__} = sub {};

      for my $fd (0,1,2) {

        if( $io_variant->[$fd] eq 'closed' ) {
          close( (\%{main::})->{(STD_NAMES)[$fd]} )
            or die "Unable to close FD$fd: $!";

          next;
        }

        my $dup_mode;
        my $io_key = $io_variant->[$fd];

        if ( $io_key =~ /_rw$/ or $io_key eq 'tty' ) {
          $dup_mode = '+>';
        }
        elsif( $fd == 0 ) {
          $dup_mode = '<';
          $io_key = $io_key . '_ro';
        }
        else {
          $dup_mode = '>';
          $io_key = $io_key . '_wo';
        }

        open (
          (\%{main::})->{(STD_NAMES)[$fd]},
          $dup_mode . '&' . $io->{$io_key}->fileno,
        ) or die "Unable to reopen $fd: $!";
      }

      exec( $^X => "t/bin/stdio_is_$tester" )
        or die "Unable to exec: $!";
    }
    else {
      waitpid( $child, 0 );
      my $wstat = $?;


      if ( ( $wstat & 0x1FFF ) == 0b0_1000_0000_0000 ) {
        $result_by_tester->{$tester} = [ map
          { ( $wstat >> ( 15 - $_ ) ) & 1 }
          (0, 1, 2)
        ];
      }
      else {
        fail sprintf(
          "Unexpected lower 13 bits during $title $tester test: %04b-%04b-%04b-%04b (%d)",
          ( map { ($wstat >> $_) & 0xF } (12, 8, 4, 0) ),
          $wstat,
        );
      }
    }
  }

  for my $fd (0, 1, 2) {
    for my $tester (keys %$result_by_tester) {
      if ( $tester eq $expected_pass_per_fd->[$fd] ) {
        cmp_ok (
          $result_by_tester->{$tester}[$fd],
          '==',
          1,
          "Found '$tester' FD$fd during $title via 'stdio_is_$tester'",
        );
      }
      elsif( $result_by_tester->{$tester}[$fd] ) {
        fail "Unexpected success for FD$fd during $title via 'stdio_is_$tester'";
      }
    }
  }
}
