use 5.006001;

# NO STRICT AND WARNINGS AND ANYTHING ELSE BEFORE THE BEGIN
# otherwise nothing nothing will work correctly

my (@modes, @handles);
BEGIN {
  die "%INC is already populated - nothing will work (perhaps unset PERL5LIB ?)\n"
    if keys %INC;

  # This is crazypants, but there is no way to grab this constant without
  # perturbing the existing FDs ( close() DOES NOT WORK on an FD <= 2 )
  # Instead we s/// it at install time
  my $F_GETFL = 3; #die "replace this";

  @modes = map
    { fcntl( $_, $F_GETFL, (my $getfl_throwaway_buf = '') ) }
    (\*STDIN, \*STDOUT, \*STDERR)
  ;

  for my $fdnum (0,1,2) {
    open (
      $handles[$fdnum],
      ( ( $fdnum == 0 ) ? '<' : '>' ) . '&=' . $fdnum,
    )
      or
    $handles[$fdnum] = undef
  }
}

use strict;
use warnings;
use File::Spec ();
use Fcntl ();

# the only thing we open in this test at compiletime is __FILE__ itself
# it may end up in various places within the low-fileno range, see if the case
# CHECK MUST HAPPEN AT RUNTIME (outside of BEGIN), otherwise pos won't match
for my $fdnum (0,1,2) {

  my @stat;
  $handles[$fdnum] = undef if defined $handles[$fdnum] and (
    ! do { no warnings 'io'; @stat = stat( $handles[$fdnum] ) }
      or
    (
      (
        join( "\0", map { $_ || '' } @stat )
          eq
        join( "\0", map { $_ || '' } stat(__FILE__) )
      )
        and
      ( sysseek( $handles[$fdnum], 0, Fcntl::SEEK_CUR() ) || 0 ) == $stat[7]
    )
  );
}

my $null_stat;

my $tests = {
  closed => sub { ! defined $handles[$_[0]] },
  tty => sub { defined $handles[$_[0]] and -t $handles[$_[0]] },
  pipe => sub { defined $handles[$_[0]] and -p $handles[$_[0]] },
  file => sub { defined $handles[$_[0]] and -f $handles[$_[0]] },
  null => sub {
    defined $handles[$_[0]]
      and
    (
      join( "\0", map { $_ || '' } stat( $handles[$_[0]] ) )
        eq
      ( $null_stat ||= join( "\0", map { $_ || '' } stat( File::Spec->devnull ) ) )
    )
  },
};

my ($t) = $0 =~ /stdio_is_([a-z]+)/
  or die "Unparseable \$0: $0\n";

die "Unknown test type '$t' (derived from $0)\n"
  unless $tests->{$t};


my $res = 0b1000;  # canary bit, make sure we never exit with 0

for (0, 1, 2) {
  my $accmode;
  if (
    defined $handles[$_]
      and
    defined( $accmode = $modes[$_] & Fcntl::O_ACCMODE() )
      and
    $accmode != Fcntl::O_RDWR()
      and
    $accmode != ( ( $_ == 0 ) ? Fcntl::O_RDONLY() : Fcntl::O_WRONLY() )
  ) {
    # wrong mode, raise the lower bits
    $res |= ( 1 << ( 2 - $_ ) );
  }

  # actual test
  $tests->{$t}->($_) and $res |= ( 1 << ( 7 - $_ ) );
}

exit $res;
